InfoMagic Internet Tools 1993 July/Internet Tools.iso/RockRidge/info-service/gopher/Rice_CMS/gopher24.readcard

Text File | 1993-01-25 | 851.3 KB | 10,763 lines

:READ  GOPHER24 FILELIST A1 TMP200 01/25/93 18:05:24
*
* This is CMS Gopher 2.4 (v2r4), client only. (beta)
* If you have any questions,  send e-mail to [e-mail].
*

*
*       Copyright 1992 Richard M. Troth.   This software was developed
*       with resources provided by Rice University and is intended
*       to serve Rice's user community.   Rice has benefitted greatly
*       from the free distribution of software,  therefore distribution
*       of unmodified copies of this material is not restricted.
*       You may change your own copy as needed.   Neither Rice
*       University nor any of its employees or students shall be held
*       liable for damages resulting from the use of this software.
*

*
* You will need RXSOCKET and CMS Pipelines.     (5785-RAC)
* You will need VM TCP/IP, V2 or later.         (5735-FAL)
*
* This file is in CMS TAR compatible format.
* (it was, in fact, used to create gopher24.tar)
*
*     filename filetype fm relative_path (may be verbose)
      GOPHER24 FILELIST *
      GOPHER24 README   *
*
* client:
      GOPHER   EXEC     *
      GOPCLI   EXEC     *
      GOPCLINI EXEC     *
      GOPCLISX REXX     *
      GOPCLITM REXX     *
      GOPCLIST REXX     *
      GOPCLIMB REXX     *
      GOPCLIUI REXX     *
      GOPCLITX REXX     *
      GOPCLIFV REXX     *
      GOPCLIGV REXX     *
      GOPCLIFI EXEC     *
      GVM      EXEC     *
      GVM      DIRECT   *
*
* server:
      GOPHERD  EXEC     *
      GOPHERD  CONFIG   *
      GOPSRV   EXEC     *
      GOPSRVLS REXX     *
      GOPSRVRP REXX     *
      GOPSRVMB REXX     *
      GOPSRVGL REXX     *
      GOPSRVAU EXEC     *
      GOPSRVYS REXX     *
      GOPHERD  DIRECT   *
*
* support:
      EXPAND   REXX     *
      PRINT    REXX     *
      A2E      REXX     *
      E2A      REXX     *
      TCPA2E   REXX     *
      TCPE2A   REXX     *
      STANDARD TCPXLATE *
      STANDARD TCPXLBIN *
*
* oh joy! a message repository:
      GOPUME   MESSAGES *
*     GOPUME   MSGAMENG *
      GOPUME   TEXT     *
*     GOPUME   TXTAMENG *
*
* files for using XEDIT as your file viewer:
      GOPXEDPR XEDIT    *
      GOPXEDII XEDIT    *
*
* a bookmark migration aid:
      GOPHMARK EXEC     *
*
* support modules:
      RXSOCKET MODULE   *
      RXSOCKET MODULESP *
      DISKWRIT MODULE   *
*     _REFRESH EXEC     *
*
* INDEX generator and search engine:  (thanks, Yossie!)
      WISHLG   MODULE   *
      WISHLP   MODULE   *
*
* CSO PhoneBook lookups:  (thanks, Nick!)
      PH       EXEC     *
*
* a tool for browsing Gopher FILELISTs on-line:
      GL       EXEC     *
*
* a tool for dumping gopherspace in line-mode:
      GOPHERCAT EXEC    *
*
* a tool for generating search (WISHLP) indices and other things:
      GOPGEN    EXEC    *
      GOPGENFL  REXX    *
*
* help files:
      GOPHER   HELPCMS  *
      BROWSER  HELPGOPHER *
      VIEWER   HELPGOPHER *
      GOP000I  HELPMSG  *
      GOPGEN   HELPCMS  *
*
* serving CMS HELP via Gopher:
      GOPHERDH REXX     *
      GOPHERDI REXX     *
      HELP     NAMES    *
      NEWS     NAMES    *
*
* general information:
      GOPHER   PROTOCOL *
      GOPHERT  GIF      *
      GOPHER  COPYRIGHT *
*
* If you pick-up RXSOCKET or DISKWRIT from a UNIX FTP host,  you must
* "de-block" them back into their CMS form (record oriented) with:
*
*   PIPE DISK RXSOCKET U-MODULE | DEBLOCK CMS | DISK RXSOCKET MODULE
*   PIPE DISK DISKWRIT U-MODULE | DEBLOCK CMS | DISK DISKWRIT MODULE
*
* sequecned sources:
* (modify these, not the EXECs and REXX pipes)
      GOPCLI   $EXEC     *
      GOPCLINI $EXEC     *
      GOPCLISX $REXX     *
      GOPCLITM $REXX     *
      GOPCLIST $REXX     *
      GOPCLIMB $REXX     *
      GOPCLIUI $REXX     *
      GOPCLITX $REXX     *
      GOPCLIFV $REXX     *
      GOPCLIGV $REXX     *
      GOPCLIFI $EXEC     *
*
      GOPSRV   $EXEC     *
      GOPSRVLS $REXX     *
      GOPSRVRP $REXX     *
      GOPSRVMB $REXX     *
      GOPSRVGL $REXX     *
      GOPSRVAU $EXEC     *
      GOPSRVYS $REXX     *
*
      VMGOPHER CNTRL     *
*
:READ  GOPHER24 README   A1 TMP200 01/22/93 18:25:16

WELCOME

Welcome to GopherSpace!   I hope you enjoy your trek.

The InterNet Gopher  (or just "gopher" for short)  is a simple
information dispersal tool based on TCP/IP.   It is an example
of the kind of seemless interoperability that is possible
when we (programmers) actually try to do things right.
The Gopher protocol doesn't care about host operating systems,
their file storage formats,  character sets,  or command suite
(or lack thereof).

CMS Gopher is based on three very strong tools:  the REXX language,
Arty Ecock's RXSOCKET,  and CMS Pipelines.   As a programmer,
I literally went to tears over how well these three work together.

More warm fuzzies later.   You need to unpack this thing.

 ------  ------  ------  ------  ------  ------  ------  ------  ------

UNPACKING

CMS Gopher is packaged in several forms.   Pick your favourite
de-archival tool and start unpacking.   Both server and client
can reside on the same disk.   (that's how they are at Rice)

CMS TAR: (Rick's choice)

Enter the command:      tar xvf gopher24 = = fm

where  fm  is the filemode of the disk or SFS directory to hold Gopher.

CARDDUMP: (Cornell 'CARD' format)

You may need to reblock the binary file with  ... | FBLOCK 80 | ... ,
then  PUNCH  it to yourself,  order it to the top of your reader,
and   CARD LOAD * * fm   to get the package onto the disk you want.

        CP SPOOL PUNCH TO *
        PUNCH GOPHER24 CARDDUMP (NOHEADER
        CP ORDER RDR spoolid
        CARD LOAD * * fm

READCARD:

This is a plain-text archive,  which means that executables are
not included.   You'll have to acquire RXSOCKET MODULE and other
binaries via some other means.   You'll have to generate the
message repository manually.   PUNCH the file to yourself with the
(NOHEADER option,  order it to the top of your reader,  then
READCARD * * fm,  where  fm  is the disk or SFS directory where you
intend to load CMS Gopher.

        CP SPOOL PUNCH TO *
        PUNCH GOPHER24 READCARD (NOHEADER
        CP ORDER RDR spoolid
        READCARD * * fm

LISTSERV:

Send a message (with either TELL or MAIL) to LISTSERV@RICEVM1
([e-mail]),

        get gopher24 package

In CMS that's:   TELL LISTSERV AT RICEVM1 GET GOPHER24 PACKAGE

LISTSERV will send you everything.   No archive extraction needed.

 ------  ------  ------  ------  ------  ------  ------  ------  ------

SETTING UP THE CLIENT

You may have some special method of giving users access to your
CMS applications.   At Rice,  we keep most applications on their own
minidisk,  and leave a  "wrapper" EXEC on a public,  always accessed
minidisk  (our X disk).

The client is GOPCLI.   Whatever wrapper you create should check for
GOPCLI EXEC and access the right disk or SFS directory if it's missing.

You may want to tailor a couple of environment variables.   There's no
CONFIG file for the client in CMS Gopher 2.4.   All configuration data
are kept in user GLOBALVs.   See  HELP GOPHER  for a list of user-settable
Global Variables.   HOST and NAME are two that many people like to predefine.
HOST is the TCP/IP host computer where your  "top level"  gopher server runs.
NAME is the name of that  "top level"  menu.   (there's no way in the
Gopher protocol for a menu to name itself;  all menus and plain files
are named by the menu that references them,  so you need to set NAME
or you'll get  "(root menu)",  harmless but ugly)

Note that the client reserves the fileid  VMGOPHER DOCUMENT  for times
when it needs to write a file to CMS disk and can't use the name
provided by the current gopher server.

PICTURES

CMS Gopher 2.4 supports the gopher "image" (type I) files.   Presently,
the only format displayable is GIF files using the VMGIF package available
from the fine folks at BLEKUL11.

 ------  ------  ------  ------  ------  ------  ------  ------  ------

SETTING UP THE SERVER

The server is GOPSRV.   Setting it up is trickier than setting up the
client because you not only have to create a virtual machine for it to
run in,  but you also have to take the time to structure your gopher data
nicely.   See  GOPHERD DIRECT for an example CP Directory entry.
You can have multiple gopher servers.

If you don't have SFS,  you can create a hierarchical set of menus using
FILELISTs.   Some VMers insist on using FLIST.   They say it's faster
than FILELIST.   Fine.   But FILELIST lets you save and load FILELISTs
such that you can easily bundle files together almost as easily as with
true directories.   If you do have SFS,  you can let it do the work of
maintaining your menu hierarchy.

Gopher FILELISTs are made up of lines of the form:

        fn  ft  fm  path  "name"  type

                where fn/ft/fm are the filename, filetype, and filemode
of the file being referenced.   The path is really only the last partof
the gopher "selector string" pointing to this file.   The paths of all
parent menus are automatically prepended.   The name (must be in quotes)
is what the user sees in the menu referencing this file.   The type is a
one-digit type indicator,  any of:

                0       this file is plain-text
                1       this item is a menu
                4       this is a Macintosh file
                5       this is an MS-DOS file
                6       this is a UUEncoded file
                7       this item is a search on a menu
                9       this is a binary file
                I       image (graphic; typically GIF)
                s       sound

There are other types,  but these are the ones most useful in FILELISTs.

Everyhing except the filename is optional.   Filetype, filemode, path,
name and type may all be omitted,  in which case the server will choose.
The first character of each line in a Gopher FILELIST must be either
a blank or an asterisk,  the latter denoting a comment.   With care,
you can in fact use a Gopher FILELIST as input to CMS' FILELIST EXEC)

I mentioned the menu type, digit 1.   Please note that you do NOT specify
a menu within a menu by marking some file as type 1,  but rather by using
a special filetype "*".   The server will automatically mark it as type 1.

The  "root"  menu is defined by <userid> FILELIST,  where <userid>
is the name of your gopher server virtual machine,  typically GOPHERD.
You can override this and other parameters in GOPHERD CONFIG.

So,  making a long story longer,  to setup your gopher server,  define
virtual machine GOPHERD,  give it access to your local gopher disk,
create GOPHERD FILELIST listing one or more files you wish to serve-out,
then  CP AUTOLOG GOPHERD.

There is a CONFIG file,  which you can tailor as needed.   With the 2.4
server,  the only variables meaningful in the config file are  LOGPIPE,
PORT,  and  ROOT.   PORT defaults to 70.   ROOT defaults to the virtual
machine name  (server's userid).   LOGPIPE defaults to CONSOLE.

You will probably want to dedicate port 70 to GOPHERD in your local
PROFILE TCPIP for you TCPIP service virtual machine.   It's also good
to have GOPHERD listed as AUTOLOGged by TCPIP.   Neither of these steps
are required to test GOPHERD;  just run it.   It's pretty harmless.

PIPES AND AUTHORIZATIONS

A nice way to degrade performance of your gopher server is to create a
NAMES file for a menu.   In spite of the cost,  this is useful because
you can control access to and/or define CMS Pipelines specifications for
menus and items in a NAMES file.

When the server accesses a directory,  it looks for <menu> NAMES.
(this works best with FILELISTs;  if you do it for SFS directories,
consider that the server may access other directories,  releasing the
one that holds your NAMES file,  as it resolves the selector path string)
If <menu> NAMES exists,  the server uses NAMEFIND to process it.
This is best explained by an example:


        :nick.myfile   :fn.my   :ft.file
                       :auth..rice.edu deny .cuny.edu .gov allow *
                       :pipe.CP Q NAMES | SPLIT /,/

For the file  MY FILE,  any host who's InterNet hostname ends in
".rice.edu"  (all of the Rice campus)  can read it.   Any host who's
InterNet hostname ends with  ".cuny.edu"  or  ".gov"  is prohibited.
Everyone else is then permitted.   If the client host is allowed access,
then instead of reading the file  MY FILE,  the server sends the output
of the pipeline  CP Q NAMES | SPLIT /,/  to the client.

This can get quite sophisticated.   No,  you do not have to have both
an auth and a pipe in the NAMES file entry.   You can have either one
or neither.   And know that CMS NAMEFIND does not provide a way to
specify the filemode of the NAMES file,  so be careful about menu
name collisions.

You can also specify  host, port, path, name, and type  in a NAMES file.
This means that you can use NAMES files in place of GOPHER (link) files,
but remember that NAMEFIND is going to cost you.

Link files?   They let you point to other gopher servers.
See the Q&A section below,  otherwise this section will go on forever.

SEARCH ITEM

Creating a search item in a menu is easy.   Set it up just like you
would any other sub-menu,  but mark it as Type 7.   Something like:

        MYSEARCH FILELIST * whatever "My Own Search Item" 7

                in the parent menu's FILELIST,  or,

        :nick.whatever :fn.mysearch :ft.filelist :type.7

There's no reason why you can't have the menu as a whole available
right next to the searched version,  like:

        MYSEARCH FILELIST * whatever "My Own Search Item" 7
        MYSEARCH FILELIST * whatever "My Own Search Item (not indexed)"

You must also create an index file for this menu.   The easiest way is
by using GOPGEN.   GOPGEN is primarily a tool for making your own mods
to CMS Gopher,  but it also performs the right incantation on WISHLG
(thank's Yossie) to create an index for you.   The server then will
invoke WISHLP (thank's again, Yossie) to list the files that match
the client's search expression.

        GOPGEN INDEX MYSEARCH

MYSEARCH FILELIST must exist.   All of the files it lists must exist.
You must then put the index file,  MYSEARCH GOPINDEX,  where the server
will access it.

 ------  ------  ------  ------  ------  ------  ------  ------  ------

FUNCTIONS OF FILES

Here's a list of most of the files in the package and their function:

      GOPHER   EXEC     "wrapper" EXEC; ensures product disk accessed
      GOPCLI   EXEC     the client
      GOPCLINI EXEC     client initialization (called once from GOPCLI)
      GOPCLTCP REXX     handles all TCP/IP work for the client
      GOPCLITM REXX     decides what how a given item should be processed
      GOPCLIST REXX     displays connection status,  "Reading ...",  etc
      GOPCLIMB REXX     menu browser
      GOPCLIUI REXX     user input (prompting)
      GOPCLTXT REXX     reformats plain-text
      GOPCLIFV REXX     file viewer; may be used stand-alone
      GOPCLIGV REXX     graphics viewer; presently GIFs only
      GOPCLIFI EXEC     returns legal CMS fileid from a gopherspace path
      GVM      EXEC     "DIALed Gopher" client; calls GOPHER to call GOPCLI
      GVM      DIRECT   CP Directory entry for the DIALed Gopher

      GOPHERD  EXEC     "wrapper" EXEC for the server; write your own
      GOPSRV   EXEC     the server
      GOPSRVLS REXX     lists files and menus (menus in LISTFILE format)
      GOPSRVRP REXX     gopher path resolution; uses GOPSRVLS output
      GOPSRVMB REXX     menu builder
      GOPSRVGL REXX     gopher "link" processor
      GOPSRVAU EXEC     performs authorization check
      GOPSRVFM EXEC     dummy filemode function for server
      GOPHERD  DIRECT   CP Directory entry for the server

      EXPAND   REXX     expands TAB characters
      PRINT    REXX     similar to CMS PRINT, but a pipe
      A2E      REXX     translate ASCII to EBCDIC
      E2A      REXX     translate EBCDIC to ASCII
      TCPA2E   REXX     A2E, but follows TCP/IP translate tables
      TCPE2A   REXX     E2A, "   "       "      "         "
      STANDARD TCPXLATE suggested ASCII <---> EBCDIC translate tables
      STANDARD TCPXLBIN binary object built from above TCPXLATE

      GOPUME   MESSAGES message repository source
      GOPUME   TEXT     message repository object

      GOPXEDPR XEDIT    XEDIT profile for XEDIT used as file viewer
      GOPXEDII XEDIT    "item info" command for XEDIT as file viewer

      GOPHMARK EXEC     migrates bookmars from 2.3

      RXSOCKET MODULE   Arty's wonderful CMS Socket tool
      RXSOCKET MODULESP VM/SP and VM/HPO version of above
      DISKWRIT MODULE   minidisk need reACCESSing?
      WISHLP   MODULE   Yossie's *fast* search engine
      WISHLG   MODULE   index builder for above

      PH       EXEC     Nick LaFlamme's CSO/qi (phonebook) client

      GL       EXEC     primitive tool for browsing CMS Gopher FILELISTs

      GOPHERCAT EXEC    dumps gopherspace files right onto your console

      GOPHERDH REXX     a pipeline stage that interprets CMS HELP
      HELP     NAMES    defines HELP menu to the server using above

 ------  ------  ------  ------  ------  ------  ------  ------  ------

There is a discussion list,  [e-mail].

There is another CMS Gopher (both server and client),  popularly called
"the Vienna Gopher",  available from Gerhard Gonter <GONTER@AWIWUW11>.

 ------  ------  ------  ------  ------  ------  ------  ------  ------

Q:      The basics, documents and FILELIST menus, is fairly easy to grasp,
        but the relationship of a NAMES file and its entries to a FILELIST
        file and its entries is not at all evident to the poor soul that
        just wants to provide an information service without much time
        invested (I.e., without subscribing to VMGOPHER).

A:      The easiest way to start is just name some plain-text files in
        GOPHERD FILELIST  (which are available to your GOPHERD service
        machine on an accessed disk or SFS directory).   Then after you're
        comfortable with that,  try some "links"  (filetype GOPHER) and
        sub-menus  (filetype FILELIST).   Then get into NAMES files.

Q:      How to I point to another server/menu?

A:      The easiest way is with a "link" file  (filetype GOPHER).
        When a link file shows-up in any FILELIST,  the contents of
        that file are read and the information specified is presented
        to the client for that particular menu item.

        The contents of a GOPHER (link) file are the same as
        for a UNIX server link file,  of the form:

                name=Rice University CMS Gopher server
                host=ricevm1.rice.edu
                port=70
                path=1/
                type=1

        As of 2.4,  GOPHER file can have more than one link in it.

Q:      How does a GOPHER file differ from a "link" in a NAMES file?

A:      The NAMES file is far more extensive.   (and exPensive)
        With the CMS Gopher server,  you don't use "link" files to
        override the characteristics of other files in the menu  (as you
        would with a UNIX server).   With the CMS server,  GOPHER (link)
        files are exclusively used to reference other network (usually
        non-local) resources,  while the NAMES file may apply to local
        files,  which reside on your system OR to remote services.

Q:      Some folks have made it seem that their gopher server files
        are free for the taking ...  is there a gopher feature
        to pull these in?

A:      To "receive" (keep) an item,  press PF5.   The receive function
        will not overwrite an existing file  (though you can still
        view & SAVE from XEDIT).

Q:      GOPHERD should document DISKWRIT in the prolog.

A:      GOPHERD uses DISKWRIT to perform the same "reaccess" trick that
        GONE EXEC does when you reconnect.   If disks appear to have
        changed,  they are reACCESSed so that the server has the latest
        revision of any files on those minidisks.

Q:      Why are the "STANDARD" translate-table files provided?
        Are these for use with the server?

A:      Both server and client.
        The default ASCII <---> EBCDIC translation in VM TCP/IP (FAL)
        is not 100% correct for the majority of the VM/UNIX/VMS/DOS/Mac
        world we live in.   STANDARD TCPXLATE and TCPXLBIN provide
        a 1-for-1 translation between  de-facto "network EBCDIC"
        (codepage 1047)  and  "extended ASCII"  (ISO 8859-1).

Q:      If PhoneBk and Search are available, how do we use them?

A:      Presently,  CMS GopherD does not support PhoneBk and Search engines.
        The client (GOPCLI) is happy to utilize such servers on other hosts.

Q:      Some GOPHERs restrict access or output to some clients;  how?

A:      Specify an "auth" value in the NAMES file.   The tag :auth.
        allows for control over any object in a menu  (defined by a
        FILELIST and/or NAMES file),  even the menu itself.

Q:      Is there anything different about your RXSOCKET?

A:      RXSOCKET is supplied because Gopher requires it.
        RXSOCKET was created by Arty Ecock.   He maintains it.
        Rice doesn't have any mods to RXSOCKET,  and Gopher doesn't
        need any special treatment from RXSOCKET.   If you find an
        RXSOCKET packaged with CMS Gopher to be out-of-date,  by all
        means,  use the current one or get the latest from Arty.

        If you pick-up RXSOCKET MODULE from a UNIX FTP host,  you must
        "deblock" it back into its CMS form (record oriented) with:

        PIPE DISK RXSOCKET U-MODULE | DEBLOCK CMS | DISK RXSOCKET MODULE

 ------  ------  ------  ------  ------  ------  ------  ------  ------

Thanks to:

Yossie Silverman,  Jim Gerland,  Arty Ecock,  Serge Goldstein,
Chuck Boeheim,  Wayne Smith,  Jim Colten,  Nick LaFlamme,
Rich Wiggins,  Martha McConaghy,  John Hartmann,  Melinda Varian,  ...

(this list continues to grow,  and some have surely been left out)

:READ  GOPHER   EXEC     A1 TMP200 01/12/93 17:09:27
/*
 *        Name: GOPHER EXEC
 *     Purpose: VM InterNet Gopher client "wrapper" EXEC
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *        Note: Tailor this locally to your own OBTAIN/DROP conventions
 *
 *        Note: Thanks to Nick LaFlamme for the linemode catcher.
 */

Parse Source system .
If system ^= "CMS" Then Do
    Say "CMS Gopher does not run on" system
    Exit -1
    End  /*  If  ..  Do  */

Address "COMMAND"

'PIPE COMMAND QUERY DISPLAY'
If rc ^= 0 Then Do
    drc = rc
    'XMITMSG 523'
    Say "CMS Gopher requires a full-screen terminal."
    Exit drc
    End  /*  If  ..  Do  */

'STATE GOPCLI EXEC *'                   /*  this is how we access     */
If rc ^= 0 Then 'EXEC OBTAIN GOPHER'    /*  applications on RICEVM1   */

'GLOBALV SELECT GOPHER GET HOST'
If host = "" Then host = "cwis.rice.edu"
'GLOBALV SELECT GOPHER PUTP HOST'

'GLOBALV SELECT GOPHER GET NAME'
If name = "" Then
        name = "RiceInfo"
/*      name = "Rice University Campus-Wide Information System"       */
'GLOBALV SELECT GOPHER PUTP NAME'

Parse Arg argstring
'EXEC GOPCLI' argstring

/*  'EXEC DROP GOPHER'  */

Exit rc

:READ  GOPCLI   EXEC     A1 TMP200 01/25/93 01:09:27
/*
 *        Name: GOPCLI EXEC
 *              VM TCP/IP Network GOPHER Client
 *      Author: Rick Troth, Rice University, Information Systems
 *              Major thanks to Arty Ecock for the wonderful RXSOCKET.
 *              Thanks to Serge Goldstein for help with many things.
 *        Date: 1992-Dec-23
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

/*
 *       Calls:
 *              RXSOCKET MODULE   -- for TCP/IP network services
 *              PIPE     MODULE   -- for various I/O functions
 *              GLOBALV           -- for temp and perm global vars
 *              XMITMSG           -- for all message output
 *              VM TCP/IP, V2 or later (through RXSOCKET)
 *
 *              GOPCLINI EXEC     -- to initialize many things
 *              GOPCLITM REXX     -- to fetch the first item (a menu)
 *              GOPCLIMB REXX     -- to display a menu (from bookmarks)
 *                     both of which call other gems
 *
 *    perm GVs:
 *        HOST  -  the host to connect to for the root menu
 *        PORT  -  the port on that host for Gopher service
 *        PATH  -  the path to the initial menu
 *        NAME  -  the name of the initial menu
 *      TELNET  -  the name of the CMS TELNET command  (user preference)
 *      TN3270  -  the name of the command for 3270 telnet connections
 *      VIEWER  -  the CMS command (XEDIT or BROWSE) used to view a file
 *   BOOKMARK.  -  prefix for all bookmark variables,  where what
 *                 follows the dot is the name of the bookmark
 *
 *    temp GVs:
 *        TUBE  -  the virtual address of a DIALed terminal (not cons)
 *      GOPHER  -  the IUCV path name and translate table name
 *      PROGID  -  program name
 *        ITEM  -  a line of "gopher menu data" for the chosen item
 *         ...
 */

Trace "OFF"

Address "COMMAND"

'SET LANGUAGE (ADD GOP USER'
If rc ^= 0 Then Exit rc

'STATE PIPE MODULE *'
If rc ^= 0 Then Do
    qrc = rc
    /*  "You must have CMS Pipelines to run CMS Gopher."  */
    'XMITMSG 3 (APPLID GOP CALLER CLI ERRMSG'
    Exit qrc
    End  /*  If  ..  Do  */

/*  Thanks to Nick LaFlamme for the linemode catcher.  */
'PIPE COMMAND QUERY DISPLAY'
If rc ^= 0 Then Do
    qrc = rc
    'XMITMSG 523 (ERRMSG'       /*  "Typewriter mode"  */
    /*  "CMS Gopher requires a full-screen terminal."  */
    'XMITMSG 926 (APPLID GOP CALLER CLI ERRMSG'
    Exit qrc
    End  /*  If  ..  Do  */

'STATE RXSOCKET MODULE *'
If rc ^= 0 Then Do
    qrc = rc
    /*  "You must have RXSOCKET to run CMS Gopher."  */
    'XMITMSG 1 (APPLID GOP CALLER CLI ERRMSG'
    Exit qrc
    End  /*  If  ..  Do  */

'STATE TCPIP DATA *'
If rc ^= 0 Then Do
    qrc = rc
    /*  "You must have VM TCP/IP V2 to run CMS Gopher."  */
    'XMITMSG 2 (APPLID GOP CALLER CLI ERRMSG'
    Exit qrc
    End  /*  If  ..  Do  */

Parse Arg host port path '(' options ')' .

If host = "" & options = "" Then 'GLOBALV SELECT GOPHER GET PATH NAME'
                            Else name = ""

/* Initialize some variables */
bookmark = ""
bkl  = 0
tube = "CONS"
quit = 0

/* process options, if any */
Do While options ^= ""
    Parse Var options op options
    Upper op
    Select  /*  op  */
        When    Abbrev("TOPIC",op,2)    | ,
                Abbrev("PATH",op,1)     Then Do
                    path = options
                    options = ""
                    End  /*  When  ..  Do  */
        When    Abbrev("TUBE",op,2)     Then
                    Parse Var options tube options
        When    Abbrev("BOOKMARK",op,1) | ,
                Abbrev("BKMARK",op,3)   Then
                    Parse Var options bookmark options
        When    Abbrev("BOOKLIST",op,5) | ,
                Abbrev("BKLIST",op,3)   Then Do
                    bkl = 1
                    End  /*  When  ..  Do  */
        When    Abbrev("TITLE",1)       Then Do
                    name = options
                    options = ""
                    End  /*  When  ..  Do  */
        Otherwise 'XMITMSG 3 OP (ERRMSG'
        End  /*  Select  op  */
    End  /*  Do  While  */

/*  initialize many GlobalVs,  including screen stem  */
'EXEC GOPCLINI' tube

/*  Now go display first menu or file or bookmark  */
Select
    When    bkl         Then Call BOOKLIST
    When bookmark ^= "" Then Call BOOKMARK
    Otherwise                Call SHOWITEM
    End  /*  Select  */

/*  clear some work GlobalVs  */
'GLOBALV SELECT GOPHER SET PROGID'
'GLOBALV SELECT GOPHER SET GOPHER'
'GLOBALV SELECT GOPHER SET TUBE'
'GLOBALV SELECT GOPHER SET ITEM'
'GLOBALV SELECT GOPHER SET COMMAND QUIT'        /* no recursion here */

Exit



/* ------------------------------------------------------------ SHOWITEM
 */
SHOWITEM:

If host = "" Then 'GLOBALV SELECT GOPHER GET HOST'
If host = "" Then host = "gopher.tc.umn.edu"

If port = "" Then 'GLOBALV SELECT GOPHER GET PORT'
If port = "" Then port = 70

If name = "" Then Do
    Parse Value Reverse(path) With name '/' .
    name = Reverse(name)
    End  /*  If  ..  Do  */

If name = "" Then Do
    'PIPE COMMAND XMITMSG 4 (APPLID GOP CALLER CLI | VAR NAME'
    Parse Var name . name
    End  /*  If  ..  Do  */

type = Left(path,1)
If type = '/' | type = ' ' Then type = '1'

item = type || name || '05'x || path || '05'x ,
            || host || '05'x || port || '05'x
'PIPE VAR ITEM | GOPCLITM OPEN | CONSOLE'

Return



/* ------------------------------------------------------------ BOOKMARK
 *  Present the selected bookmark or fall-back to the list of all.
 */
BOOKMARK:

/*  if bookmark was specified numeric,  just fetch it  */
If Datatype(bookmark,'N') Then Do
    i = Trunc(bookmark)
    'PIPE COMMAND GLOBALV SELECT GOPHER GET BOOKMARK.' || i
    If bookmark.i ^= "" Then Do
        'PIPE VAR BOOKMARK.' || i '| GOPCLITM OPEN | CONSOLE'
        Return
        End  /*  If  ..  Do  */
    End  /*  If  ..  Do  */



/* ------------------------------------------------------------ BOOKLIST
 *  Present a menu of all of the user's bookmarks.
 */
BOOKLIST:

If name = "" Then Do
    /*  extract personal name from NAMES file  */
    Parse Value Diag(08,'QUERY USERID') With user . host . '15'x .
    'PIPE COMMAND NAMEFIND :USERID' user ':NODE' host ,
        ':NAME | VAR PERSONAL'
    If rc = 0 & personal ^= "" Then
        /*  make a title line for bookmark list  */
        'PIPE COMMAND XMITMSG 40 PERSONAL' ,
            '(APPLID GOP CALLER CLI NOHEADER | VAR NAME'
    End  /*  If  ..  Do  */

/*  extract bookmarks from GlobalVs  */
'PIPE COMMAND GLOBALV SELECT GOPHER LIST' ,
        '| LOCATE 1-10 / BOOKMARK./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0
                             Else bookmark.0 = Trunc(bookmark.0)

'PIPE STEM BOOKMARK. | GOPCLIMB' name '| CONSOLE'
If rc ^= 0 Then Return

'GLOBALV SELECT GOPHER GET COMMAND'
Parse Upper Var command verb .
If Abbrev("QUIT",verb,1) Then Return

/*  remove any blanked (deleted) bookmarks from the stem  */
j = 0
'GLOBALV SELECT GOPHER GET BOOKMARK.0'
Do i = 1 to bookmark.0
    'GLOBALV SELECT GOPHER GET BOOKMARK.' || i
    If  Symbol("BOOKMARK." || i) = "LIT"    | ,
                      bookmark.i = ""       | ,
                 Left(bookmark.i,1) = 'i'   Then    Iterate
    j = j + 1
    bookmark.j = bookmark.i
    'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || j
    End
bookmark.0 = j
'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'

Return

:READ  GOPCLINI EXEC     A1 TMP200 01/22/93 11:48:06
/*
 *        Name: GOPCLINI EXEC
 *              CMS InterNet Gopher (client) initialization
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23, 1993-Jan-22
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

Address "COMMAND"

Parse Upper Arg . '(' opts ')' .
fsin = 1;   load = 1
Do While opts ^= ""
    Parse Var opts op opts
    Select  /*  op  */
        When  Abbrev("UNLOAD",op,3)     Then  Signal  UNLOAD
        When  Abbrev("NOSCREEN",op,3)   Then  fsin = 0
        When  Abbrev("NOLOAD",op,3)     Then  load = 0
        When  Abbrev("SCREEN",op,3)     Then  fsin = 1
        When  Abbrev("LOAD",op,1)       Then  load = 1
        Otherwise 'XMITMSG 3 OP (ERRMSG'
        End  Select  /*  op  */
    End  /*  Do  While  */

'SET LANGUAGE (ADD GOP USER'
If rc ^= 0 Then Exit rc

/*  fetch the program ID string  */
'PIPE COMMAND XMITMSG 0 (APPLID GOP CALLER CLI NOHEADER | VAR PROGID'

/*  migrate old bookmarks  */
'EXEC GOPHMARK'

Parse Upper Arg tube . '(' . ')' .

'GLOBALV SELECT GOPHER PUT GOPHER PROGID TUBE'
'GLOBALV SELECT GOPHER SET ITEM'
'GLOBALV SELECT GOPHER SET COMMAND'

/*  initialize screen variables  */
If fsin Then Do
    If ^Datatype(tube,'X') Then 'VMFCLEAR'      /*  clear if cons  */
    Call FSINIT tube            /*  figure out some screen attribs  */
    'PIPE REXXVARS | DROP | JOIN 1 /,/ | LOCATE /n FS./' ,
            '| CHANGE /n /GLOBALV SELECT GOPHER SETL / 1' ,
                    '| CHANGE /,v / / 1 | COMMAND'
    End  /*  If  ..  Do  */

/*  load client gems into memory for efficiency  */
If load Then
'PIPE CMS L GOPCLI* REXX * | SPEC /EXECLOAD / 1 1-* NEXT | COMMAND'

Exit



/* -------------------------------------------------------------- FSINIT
 * Initialize variables used in building screen displays.
 * (this code comes from Chuck Boeheim's PIPEDEMO; Thanks, Chuck!)
 */
FSINIT:   Procedure Expose fs.
Parse Arg t
fs.tube = t

If Datatype(fs.tube,'X') Then Do

    /*----------------------------------------------------------------*/
    /*  a dialed 3270 with pessimistic assumptions                    */
    /*----------------------------------------------------------------*/

    fs.scrrows = 24
    fs.scrcols = 80
    fs.write  = '80'x
    flags = '00'x

    End  /*  If  ..  Do  */

Else Do

    /*----------------------------------------------------------------*/
    /*  Get the screen size from CP.                                  */
    /*----------------------------------------------------------------*/

    Parse Value Diag('8C') with flags +1 3 fs.scrcols +2 fs.scrrows +2 .
    fs.scrrows = c2d(fs.scrrows)
    fs.scrcols = c2d(fs.scrcols)

    If  fs.scrrows > 24 | fs.scrcols > 80   Then fs.write = 'C0'x
                                            Else fs.write = '80'x

    End  /*  Else  Do  */

fs.operwa = 'C0'x       /* Erase/Write alternate      */
fs.operw  = '80'x       /* Erase/Write                */
fs.opwr   = '00'x       /* Write                      */
fs.oprd   = '06'x       /* Read modified.             */

fs.wcc    = '03'x       /* Unlock keyboard, reset mdt */

fs.high   = '1DE8'x     /* Protected, highlighted.    */
fs.low    = '1D60'x     /* Protected, normal.         */
fs.ic     = '13'x       /* Insert cursor.             */

fs.color = (bitand(flags,'80'x) = '80'x)
fs.exthi = (bitand(flags,'40'x) = '40'x)
fs.pss   = (bitand(flags,'20'x) = '20'x)
fs.7171  = (bitand(flags,'02'x) = '02'x)
fs.14bit = (bitand(flags,'01'x) = '01'x)

Return



/* -------------------------------------------------------------- UNLOAD
 *  Unload Gopher EXECs, pipeline stages, messages to free-up memory.
 */
UNLOAD:

'PIPE COMMAND EXECMAP | LOCATE 1.3 /GOP/' ,
        '| SPEC /EXECDROP / 1 1.20 NEXT | COMMAND'
If rc ^= 0 Then Exit rc

'SET LANGUAGE (DELETE GOP USER'

If rc ^= 0 Then Exit rc

Exit

:READ  GOPCLISX REXX     A1 TMP200 01/24/93 23:28:05
/*
 *        Name: GOPCLISX REXX
 *              CMS Gopher client TCP/IP (sockets; "sox") function
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *       Input: one or more gopher menu lines
 *    Output 0: zero or more blocks of raw (may be ASCII) data
 *    Output 1: status messages and/or error messages
 *
 *        Note: input is "plain text" (EBCDIC),  while output
 *              may be anything.   If output is "plain text" (ASCII),
 *              the following stage must handle translation.
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

/*  sync with input so that 'CALLPIPE COMMAND' will work  */
'PEEKTO'

'CALLPIPE COMMAND GLOBALV SELECT GOPHER GET GOPHER'
If gopher = "" Then gopher = "Gopher"
quit = 0

Parse Arg . '(' opts ')' .

trans = 0
Do While opts ^= ""
    Parse Var opts op opts
    Upper op
    Select  /*  op  */
        When Abbrev("TRANSLATE",op,4) Then trans = 1
        When Abbrev("NOTRANSLATE",op,6) Then trans = 0
        Otherwise Address "COMMAND" 'XMITMSG 3 OP (ERRMSG'
        End  /*  Select  op  */
    End  /*  Do  While  */

If trans Then crlf = '0D25'x
         Else crlf = '0D0A'x

/*
 *   Initialize RXSOCKET
 */
maxdesc = Socket('Initialize', gopher)
If maxdesc = "-1" Then Do
    If errno ^= "ESUBTASKALREADYACTIVE" Then Do
    /*  Call STATUS tcperror()  */
        Exit -1
        End  /*  If  ..  Do  */
    rc = Socket('Terminate')
    maxdesc = Socket('Initialize', gopher)
    If maxdesc = "-1" Then Do
        Call STATUS tcperror()
        Exit -1
        End  /*  If  ..  Do  */
    End  /*  If  ..  Do  */

/*  L O O P  */

Do Forever

    'PEEKTO ITEM'
    If rc ^= 0 Then Leave

    Parse Var item 1 type 2 name '05'x path '05'x host ,
                                 '05'x port '05'x xtra
    port = Strip(port)              /*  for robustness  */
    If type = '7' Then path = path || '05'x || xtra

    /*  Call STATUS "Connecting ... press ENTER twice to abort"  */
    /*  Call STATUS "Connecting to" host "port" port  */
    Call STATUS 22 '"' || host || '"' '"' || port || '"'

    /*
     *   Request a new socket descriptor (TCP protocol)
     */
    socket = Socket('Socket', 'AF_INET', 'Sock_Stream')
    If socket = "-1" Then Do
        Call STATUS tcperror()
        Exit -1
        End  /*  If  ..  Do  */

    If trans Then Do
        /*
         *   Enable ASCII<->EBCDIC Translation Option
         */
        rc = Socket('SetSockOpt', socket, 'SOL_SOCKET', 'SO_EBCDIC', 1)
        If rc = "-1" Then Do
            Call STATUS tcperror()
            Exit -1
            End  /*  If  ..  Do  */
        End  /*  If  ..  Do  */

    /*
     *   Connect to the server
     */
    Parse Var host h1 '.' h2 '.' h3 '.' h4 '.' .
    If  Datatype(h1,'N') &,
        Datatype(h2,'N') &,
        Datatype(h3,'N') &,
        Datatype(h4,'N')    Then
        hisaddr = d2c(h1) || d2c(h2) || d2c(h3) || d2c(h4)
    Else Do
        hisaddr = Socket('GetHostByName', host)
        If hisaddr = "-1" Then Do
        Call STATUS tcperror()
            Exit -1
            End  /*  If  ..  Do  */
        End  /*  Else  Do  */

    /*  Parse Var hisaddr h1 +1 h2 +1 h3 +1 h4 +1 .  */

    name = AF_INET || Htons(port) || hisaddr

    /*
     *   Set this socket to non-blocking mode
     */
    rc = Socket('Ioctl', socket, 'FIONBIO', 1)
    If rc="-1" Then Do
        Call STATUS tcperror()
        Exit -1
        End  /*  If  ..  Do  */

    /*
     *   Connect to the host
     */
    rc = Socket('Connect', socket, name)
    If rc = "-1" Then ,
        If errno ^= "EINPROGRESS" Then Do
            Call STATUS tcperror()
            If errno = "ECONNREFUSED" Then ,
                Call STATUS 23 '"' || host || '"' '"' || port || '"'
        Exit -1
        End  /*  If  ..  Do  */

    rc = FD_ZERO('readmask')
    rc = FD_ZERO('writemask')
    rc = FD_SET(socket,'writemask')
    rc = FD_SET('0', 'readmask')

    rc = Socket('Select', socket+1, 'readmask', 'writemask', 0, 20)
    If rc="-1" Then Do
        Call STATUS tcperror()
        Exit -1
        End  /*  If  ..  Do  */

    If FD_ISSET('0', 'readmask')<>0 Then Do
        rc = Socket('Close', socket)
        /*  Call STATUS "Connection canceled by user request"  */
        Call STATUS 28
        Exit -1
        End

    If FD_ISSET(socket, 'writemask')=0 Then Do
        rc = Socket('Close', socket)
        /*  Call STATUS "Connection canceled by TIMEOUT"  */
        Call STATUS 29
        Exit -1
        end

    /* Return to standard mode
    rc = Socket('Ioctl', socket, 'FIONBIO', 0)
     */

    /*  TRANSlate option will affect both writing to,  as well as     *
     *  reading from,  the socket.   So if the socket is set for      *
     *  TRANSLATE,  then we need not translate the path from EBCDIC   *
     *  to ASCII.   But if not,  then we must do so as follows:       */
    If ^trans Then
    'CALLPIPE VAR PATH | TCPE2A' gopher '| VAR PATH'

    /*
     *   Send the "query" to the server
     */
    bytes_out = Socket('Write', socket, path || crlf)
    If bytes_out = "-1" Then Do
        If errno = 'EPIPE' Then ,
            'OUTPUT' "ECONNREFUSED"
        If errno = 'EPIPE' Then ,
            Call STATUS 23 '"' || host || '"' '"' || port || '"'
        Else Call STATUS tcperror()
        Exit -1
        End  /*  If  ..  Do  */

    /*  Call STATUS "Reading ... press ENTER twice to abort"  */
    /*  Call STATUS "Reading ... "  */
    /*  Call STATUS 24  */

    totbytes = 0
prevtot = 0
    /*
     *   Loop, reading response and sending to the next pipeline stage
     */
    Do Forever
        /* Set up to trap console ENTER key */
        rc = FD_ZERO('readmask')
        rc = FD_SET('0','readmask')
        rc = FD_SET(socket,'readmask')

        /* Wait for something to happen */
        rc = Socket('Select',socket+1,'readmask',0,0)
        /* If console input, clear 'socket' and return */
        If FD_ISSET('0','readmask')<>0 Then Do
            /*  Call STATUS "Request ABORTED"  */
            Call STATUS 27
            rc = Socket('Close', socket)
            Leave
            End

        bytes_in = Socket('Read', socket, 'pack')
        If bytes_in = "-1" Then
            Call STATUS tcperror()
        If bytes_in < 1 Then Leave

        totbytes = totbytes + bytes_in
If prevtot/totbytes < 0.9 Then  /* adjust the 0.9 factor to taste */
Do
        Call STATUS 26 '"' || totbytes || '"'
prevtot = totbytes
End
        'OUTPUT' pack
        If rc ^= 0 Then Leave

        End  /*  Do  Forever  */

    If rc ^= 0 Then Leave

    /*
     *   All done, relinquish our socket descriptor
     */
    rc = Socket('Close', socket)
    If rc = "-1" Then Do
        Call STATUS tcperror()
        Leave
        End  /*  If  ..  Do  */

    'READTO'

    End  /*  Do  Forever  */

/*
 *   Tell RXSOCKET that we are done with this IUCV path
 */
rc = Socket('Terminate')
If rc = "-1" Then Do
    Call STATUS tcperror()
    Exit -1
    End

/*  an empty line as last in status stream indicates success  */
/*  Call STATUS " "  */

Exit



/* -------------------------------------------------------------- STATUS
 * Write  "status messages"  to the secondary stream,  if connected.
 * This routine saves & restores the current stream selection.
 * (though there are presently no other streams used besides 1 and 0)
 */
STATUS:   Procedure
Parse Arg string

/* note the current stream (should be zero) */
'STREAMNO OUTPUT'
If rc < 0 Then Return
stream = rc

/* select secondary stream and output the string */
'SELECT OUTPUT 1'
If rc ^= 0 Then Return
If Datatype(Word(string,1),'N') Then
'CALLPIPE COMMAND XMITMSG' string '(APPLID GOP CALLER TCP ERRMSG | *:'
Else 'OUTPUT' string
'SELECT OUTPUT' stream

Return

:READ  GOPCLITM REXX     A1 TMP200 01/25/93 00:44:11
/*
 *        Name: GOPCLITM REXX
 *              VM TCP/IP Network GOPHER Client item processor
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *       Input: one or more gopher menu lines
 *      Output: zero or more information or error messages
 *              (EOF does not propagate back to input)
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

Parse Upper Arg disp . '(' . ')' .
If disp = "" Then disp = "OPEN"
/*  Say open  */

/*  sync with input so that 'CALLPIPE COMMAND' will work  */
'PEEKTO'

'CALLPIPE COMMAND GLOBALV SELECT GOPHER GET GOPHER PROGID'

/*  fetch fs. stem variable from GlobalVs  */
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
If ^Datatype(fs.tube,'X') Then fs.tube = ""

/*  prepare for dynamic connection statistics  */
stat = 'STEM STAT. | GOPCLIST'

Do Forever

    'PEEKTO ITEM'
    If rc ^= 0 Then Leave

    'CALLPIPE COMMAND GLOBALV SELECT GOPHER PUT ITEM'

    Parse Var item name '05'x path '05'x host '05'x port '05'x xtra
    Parse Var name 1 type 2 name

stat.0 = 0

    Select  /*  type  */

        When  type = '0'  Then  Call  OPENFILE

        When  type = '1'  Then  Call  OPENMENU

        When  type = '2'  Then  Call  LOOKUP

        When  type = '4'  Then  Call  OPENFILE  /* MAC */

        When  type = '5'  Then  Call  OPENFILE  /* DOS */

        When  type = '6'  Then  Call  OPENFILE  /* UUE */

        When  type = '7'  Then  Call  SEARCH

        When  type = '8'  Then  Call  TELNET

        When  type = '9'  Then  Call  BINARY

        When  type = 'T'  Then  Call  TN3270

        When  type = 'r'  | ,
              type = 'v'  Then  Call  CMSBLOCK

        When  type = 'I'  | ,
              type = ':'  | ,
              type = 'g'  Then  Call  GRAPHICS

        Otherwise               Call  OPENFILE

        End  /*  Select  type  */

If rc ^= 0 Then 'CALLPIPE STEM STAT. | *:'

    'READTO'

    End  /*  Do  Forever  */

Exit rc * (rc ^= 12)



/* ------------------------------------------------------------ OPENFILE
 *  View or retrieve a plain text file.
 */
OPENFILE:

filter = 'GOPCLITX'

If disp = "KEEP" Then Signal KEEPFILE

'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
    '| GOPCLITX | GOPCLIFV | *:' ,
    '! E: |' stat

Return



/* ------------------------------------------------------------ OPENMENU
 *  View or retrieve a plain text file.
 */
OPENMENU:

filter = 'GOPCLITX'

If disp = "KEEP" Then Signal KEEPFILE

'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
    '| GOPCLITX | GOPCLIMB | *:' ,
    '! E: |' stat

Return



/* -------------------------------------------------------------- LOOKUP
 *  Perform user lookup.   (punt to PH EXEC or equivalent)
 */
LOOKUP:

host = Strip(host)
port = Strip(port)
'CALLPIPE COMMAND GLOBALV SELECT PHCMS PUT HOST PORT'
Address "CMS" 'PH'

Return



/* -------------------------------------------------------------- SEARCH
 */
SEARCH:

'CALLPIPE COMMAND XMITMSG 601 (APPLID GOP NOHEADER' ,
        '| GOPCLIUI | VAR KEYWORDS'
keywords = Strip(keywords)
If keywords = "" Then Return

/*  prepend a  path<TAB>  to search string for WAIS servers  */
/*  path = path || '05'x || keywords  */
item = item || '05'x || keywords

'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
    '| GOPCLITX | GOPCLIMB | *:'
    '! E: |' stat

Return



/* -------------------------------------------------------------- TELNET
 */
TELNET:

If fs.tube ^= "" Then Do
    /*  'OUTPUT' "Can't TELNET from this screen"  */
    'CALLPIPE COMMAND XMITMSG 512 "TELNET"' ,
            '(APPLID GOP CALLER CLI ERRMSG | *:'
    Return
    End /* If .. Do */

Address "COMMAND"

'VMFCLEAR'
If port = 0 Then port = ""
/*  Say progid "TELNET" host port  */
'XMITMSG 30 HOST PORT (APPLID GOP CALLER CLI ERRMSG'
/*  Say name  */
'XMITMSG 7 NAME (APPLID GOP CALLER CLI ERRMSG NOCOMP'

If path ^= "" Then Do
    /*  Say "login with:" path  */
    'XMITMSG 32 PATH (APPLID GOP CALLER CLI NOHEADER'
    /*  Say "Press ENTER to continue ... "  */
    'XMITMSG 33 (APPLID GOP CALLER CLI NOHEADER'
    Parse External
    End  /*  If  ..  Do  */

'GLOBALV SELECT GOPHER GET TELNET'
If telnet = "" Then telnet = "TELNET"
Address "CMS" telnet host port
'VMFCLEAR'

Address

Return



/* -------------------------------------------------------------- BINARY
 *  Load a "binary" (byte stream) file onto disk.
 */
BINARY:

filter = ""

If disp = "KEEP" Then Signal KEEPFILE

'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
    '| GOPCLIFV | *:' ,
    '! E: |' stat

Return



/* -------------------------------------------------------------- TN3270
 *  This is almost exactly the same as the  TELNET  routine,
 *  but we let the user run a different program,  specified in
 *  global variable  TN3270,  if they wish.
 */
TN3270:

If fs.tube ^= "" Then Do
    /*  'OUTPUT' "Can't TN3270 from this screen"  */
    'CALLPIPE COMMAND XMITMSG 512 "TN3270"' ,
            '(APPLID GOP CALLER CLI ERRMSG | *:'
    Return
    End /* If .. Do */

Address "COMMAND"

'VMFCLEAR'
If port = 0 Then port = ""
/*  Say progid "TN3270" host port  */
'XMITMSG 31 HOST PORT (APPLID GOP CALLER CLI ERRMSG'
/*  Say name  */
'XMITMSG 7 NAME (APPLID GOP CALLER CLI ERRMSG NOCOMP'
If path ^= "" Then Do
    /*  Say "login with:" path  */
    'XMITMSG 32 PATH (APPLID GOP CALLER CLI NOHEADER'
    /*  Say "Press ENTER to continue ... "  */
    'XMITMSG 33 (APPLID GOP CALLER CLI NOHEADER'
    Parse External
    End  /*  If  ..  Do  */

'GLOBALV SELECT GOPHER GET TN3270'
If tn3270 = "" Then Do
    'GLOBALV SELECT GOPHER GET TELNET'
    If telnet = "" Then telnet = "TELNET"
    tn3270 = telnet
    End  /*  If  ..  Do  */
Address "CMS" tn3270 host port
'VMFCLEAR'

Address

Return



/* ------------------------------------------------------------ CMSBLOCK
 *  Save a record oriented file (type 'r' or type 'v') onto disk.
 */
CMSBLOCK:

filter = 'DEBLOCK CMS'

If disp = "KEEP" Then Signal KEEPFILE

'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
    '| DEBLOCK CMS | GOPCLIFV | *:' ,
    '! E: |' stat

Return



/* ------------------------------------------------------------ GRAPHICS
 *  Display or save a graphics (type 'I') file.
 */
GRAPHICS:

filter = ""     /*  same as for  "binary"  files  */

If disp = "KEEP" Then Signal KEEPFILE

'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
        '| GOPCLIGV | *: ! E: |' stat

Return



/* ------------------------------------------------------------ KEEPFILE
 *  Save the selected file on disk.
 */
KEEPFILE:

If fs.tube ^= "" Then Do
    'CALLPIPE COMMAND XMITMSG 508 (APPLID GOP CALLER CLI ERRMSG | *:'
    Return
    End  /*  If  ..  Do  */

Parse Var path 1 . 2 path    /*  discard type indicator  */
file = gopclifi(path)
'CALLPIPE CMS STATE' file 'A | VAR NOTFOUND'
If rc ^= 0 & rc ^= 28 Then 'CALLPIPE VAR NOTFOUND | *:'
If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 594 FILE' ,
        '(APPLID GOP CALLER CLI ERRMSG | *:'
If rc ^= 28 Then Return

If filter = "" Then
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
        '| >' file 'A' ,
        '! E: |' stat
Else
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,
        '|' filter '| >' file 'A' ,
        '! E: |' stat

If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 571 FILE PATH' ,
        '(APPLID GOP CALLER CLI ERRMSG | *:'
/*  If rc = 0 Then errmsg = "Created" fn ft fm "from" path  */

Return

:READ  GOPCLIST REXX     A1 TMP200 01/22/93 12:07:00
/*
 *        Name: GOPCLIST REXX
 *              VM TCP/IP Network GOPHER Client transaction status
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-12
 *
 *       Input: zero or more connection status messages
 *      Output: -none-
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

/*  sync with input  */
'PEEKTO'
If rc ^= 0 Then Exit rc * (rc ^= 12)

/*  abort if we're not in a 370 mode machine  */
Parse Value Diag(08,'QUERY SET') With . "MACHINE" mach . ',' . '15'x .
If mach ^= "370" & mach ^= "" Then Do
    'CALLPIPE *: | HOLE'
    Exit rc
    End  /*  If  ..  Do  */

/*  fetch fs. stem variable from GlobalVs  */
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
If ^Datatype(fs.tube,'X') Then fs.tube = ""

/*  prepare for dynamic connection statistics  */
_wid = fs.scrcols - 2
_sba = c2x(sba(1,-1) || '1D60'x)

'CALLPIPE *: | CHOP ' _wid '| PAD' _wid ,
       '| SPEC /00C3' || _sba || '/ X2C 1 1-* NEXT' ,
       '| FULLSCR' fs.tube 'NOREAD | HOLE'

Exit rc



/* ----------------------------------------------------------------- SBA
 *  (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
 *  Construct Set Buffer Address order from row and column.
 */

SBA:      Procedure Expose fs.

arg row , col, .
row = Trunc(row)
col = Trunc(col)

/*-----------------------------------------------------------------*/
/* Calculate binary address.                                       */
/*-----------------------------------------------------------------*/

offset = row * fs.scrcols + col
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End

if fs.14bit then return '11'x || d2c(offset,2)

/*-----------------------------------------------------------------*/
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
/*-----------------------------------------------------------------*/

'CALLPIPE var offset'               ,   /* Start with char number.    */
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
                '01-09 C1-C9'       ,   /*   buffer address.          */
                '11-19 D1-D9'       ,   /*                            */
                '22-29 E2-E9'       ,   /*                            */
                '30-39 F0-F9'       ,   /*                            */
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
    '| var offset'                      /* Put back in variable.      */

Return offset

:READ  GOPCLIMB REXX     A1 TMP200 01/25/93 00:34:18
/*
 *        Name: GOPCLIMB REXX
 *              VM TCP/IP Network GOPHER Client menu browser
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *       Input: one or more gopher menu lines
 *      Output: zero or more information or error messages
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

Parse Arg args '(' . ')' .

/*  verify availability of input  */
'PEEKTO'
If rc ^= 0 & rc ^= 12 Then Exit rc
If rc = 12 Then Do  /*  empty menu  */
    'CALLPIPE COMMAND XMITMSG 60 (APPLID GOP CALLER CLI ERRMSG | *:'
    Exit
    End  /*  If  ..  Do  */

Address "COMMAND" 'GLOBALV SELECT GOPHER GET' ,
        'GOPHER PROGID VIEWER ITEM'
quit = 0

Parse Var item name '05'x path '05'x host '05'x port '05'x xtra
Parse Var name 1 . 2 name       /*  discard type indicator byte  */
Parse Var path 1 . 2 path       /*  discard type indicator byte  */
If name = "" Then name = args
booklist = (item = "")

/*  fetch fs. stem variable from GlobalVs  */
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
If ^Datatype(fs.tube,'X') Then fs.tube = ""

'CALLPIPE *: | STEM MENU.'

/* is it a server error? */
If menu.0 = 1 & Left(menu.1,1) = '-' Then Do
    Parse Var menu.1 . '-' errmsg '05'x .
    'OUTPUT' errmsg
    Exit
    End  /*  If  ..  Do  */

/*  display the menu and process user's response  */
row = 0;        col = 0         /*  reset later  */
ki = menu.0;    kl = fs.scrrows - 5;    ko = 1
needle = ""     /*  may be re-used within this context  */
message.0 = 0
command = ""

If booklist Then 'CALLPIPE COMMAND XMITMSG 615' ,
        '(APPLID GOP CALLER CLI NOCOMP | SPEC WORD 2-* 1 | STEM HELP.'
            Else 'CALLPIPE COMMAND XMITMSG 613' ,
        '(APPLID GOP CALLER CLI NOCOMP | SPEC WORD 2-* 1 | STEM HELP.'

'CALLPIPE COMMAND XMITMSG 5 (APPLID GOP NOHEADER | VAR MORE'

Do Forever

    /*  write the program title line  */
    wscreen = sba(0,-1) || field("BLUE","PROT") || sba(0,0) || progid ,
                        || sba(0,fs.scrcols-Length(host)-1) || host

    /*  no SBA for status because it follows host immediately  */
    If message.0 < 1 Then Do
    wscreen = wscreen   || field("PROT") || Left(ko || '/' || ki, 11)
    If ko + kl <= ki Then
    wscreen = wscreen   || field("WHITE","HIGH","PROT") || more
        End  /*  If  ..  Do  */

    /*  don't write status or name if they'll be overlaid  */
    If message.0 < 2 Then
    wscreen = wscreen   || sba(2,(fs.scrcols-Length(name))/2) ,
                        || field("WHITE","PROT") || name

    /*  write as many message lines as needed  */
    If message.0 > 0 Then Do
        Do i = 1 to message.0
            wscreen = wscreen || sba(i,-1) ,
                || field("RED","HIGH","PROT") || message.i
            End  /*  Do  For  */
        message.0 = 0
        End  /*  If  ..  Do  */
    /*  we should probably limit that count  */

    /*  write those PFkey settings  */
    wscreen = wscreen   || sba(fs.scrrows-2,-1) ,
                        || field("BLUE","PROT") ,
                        || help.1 ,
                        || sba(fs.scrrows-1,-1) ,
                        || field("BLUE","PROT") ,
                        || help.2

    i = 1; j = ko
    Do While i <= kl & j <= ki

        Parse Var menu.j _name '05'x .
        Parse Var _name 1 _type 2 _name
        'CALLPIPE VAR _NAME | XLATE OUTPUT' ,
            '| XLATE *-* 00-3F 40 FF 40 | VAR _NAME'

        wscreen = wscreen || sba(i+2,-1) ,
                          || field("BLUE","PROT","HIGH")
        If _type = 'i' Then
        wscreen = wscreen || Left(_name,fs.scrcols-1)
                      Else Do
        wscreen = wscreen || Left(gtag(_type),11) ,
                          || field("GREEN") ,
                          || Left(_name,fs.scrcols-13)
            If row = 0 Then Do
                row = i + 2;    col = 12
                End  /*  If  ..  Do  */
            End  /*  Else  Do  */

        i = i + 1;  j = j + 1

        End  /*  Do  While  */

    rscreen = write_read(wscreen || sba(row,col) || '13'x)
    Parse Var rscreen 1 aid 2 offset . '11'x rscreen
    offset = fix(offset)
    row = offset % fs.scrcols; col = offset // fs.scrcols

    /*  keep the row/col values within bounds  */
    If  row      <   3       Then row = 3
    If  row      >   kl + 3  Then row = kl + 3
    If  row + ko >   ki + 3  Then row = ki + 3 - ko
    col = 12    /*  just reset it  */

    i = row + ko - 3

    Select /* aid */
        When  aid = '7D'x   /* enter */ | ,
              aid = 'F2'x   /*  PF2  */ | ,
              aid = 'C2'x   /*  PF14 */ | ,
              aid = '7B'x   /*  PF11 */ | ,
              aid = '4B'x   /*  PF23 */ Then  Call  OPEN
        When  aid = 'F3'x   /*  PF3  */ | ,
              aid = 'C3'x   /*  PF15 */ Then  Leave
        When  aid = 'F4'x   /*  PF4  */ | ,
              aid = 'C4'x   /*  PF16 */ Then  Call  PRINT
        When  aid = 'F5'x   /*  PF5  */ | ,
              aid = 'C5'x   /*  PF17 */ Then  Call  KEEP
        When  aid = 'F6'x   /*  PF6  */ | ,
              aid = 'C6'x   /*  PF18 */ Then  Call  FIND
        When  aid = 'F7'x   /*  PF7  */ | ,
              aid = 'C7'x   /*  PF19 */ Then Do
            ko = Max(ko-kl+1,1)
            row = 3
            End  /*  When  ..  Do  */
        When  aid = 'F8'x   /*  PF8  */ | ,
              aid = 'C8'x   /*  PF20 */ Then Do
            ko = Min(ko+kl-1,ki)
            row = 3
            End  /*  When  ..  Do  */
        When  aid = 'F9'x   /*  PF9  */ | ,
              aid = 'C9'x   /*  PF21 */ Then  Call  MARK
        When  aid = '7A'x   /*  PF10 */ | ,
              aid = '4A'x   /*  PF22 */ Then  Call  BOOKLIST
        When  aid = '6D'x   /* clear */ | ,
              aid = '6E'x   /*  PA2  */ Then Do
            row = 3;    col = 12;   ko = 1
            End  /*  When ..  Do  */
        When  aid = '7C'x   /*  PF12 */ | ,
              aid = '4C'x   /*  PF24 */ | ,
              aid = 'F0'x   /* sysrq */ | ,
              aid = '6C'x   /*  PA1  */ Then  quit = 1
        When  aid = 'F1'x   /*  PF1  */ | ,
              aid = 'C1'x   /*  PF13 */ Then  Call  HELP
        When  aid = '00'x               Then Do
            /*  I/O error on screen  */
            'CALLPIPE COMMAND XMITMSG 925 (APPLID GOP' ,
                    'CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
            Leave
            End
        Otherwise  Do   /*  Undefined PFkey/PAkey  */
            'CALLPIPE COMMAND XMITMSG 657 "' || c2x(aid) || '"' ,
                '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
            End  /*  Otherwise  Do  */
        End  /*  Select  aid  */

    Address "COMMAND" 'GLOBALV SELECT GOPHER GET COMMAND'
    Parse Upper Var command cmdverb .
    quit = (quit | Abbrev("QUIT",cmdverb,1))

    If quit Then Leave

    End  /*  Do  Forever  */

If quit Then command = "QUIT"

'CALLPIPE STEM MESSAGE. | *:'

Parse Upper Var command cmdverb .
Address "COMMAND" 'GLOBALV SELECT GOPHER PUT' ,
        'COMMAND CMDVERB'

Exit



/* ---------------------------------------------------------------- OPEN
 */
OPEN:

'CALLPIPE VAR MENU.' || i '| GOPCLITM OPEN | STEM MESSAGE. APPEND'

Return



/* --------------------------------------------------------------- PRINT
 * Print the current "menu" on the user's virtual printer.
 */
PRINT:

If fs.tube ^= "" Then Do
    /*  "Can't PRINT from this terminal."  */
    'CALLPIPE COMMAND XMITMSG 507 (APPLID GOP CALLER CLI ERRMSG' ,
            '| STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

'CALLPIPE STEM MENU. | XLATE *-* 05 7A' ,
        '| PRINT (TITLE' name '| STEM MESSAGE. APPEND'

Return



/* ---------------------------------------------------------------- KEEP
 */
KEEP:

'CALLPIPE VAR MENU.' || i '| GOPCLITM KEEP | STEM MESSAGE. APPEND'

Return



/* ---------------------------------------------------------------- FIND
 *  Find a particular string within the menu being viewed.
 *  Call GOPCLIUI for user input with prompt.
 */
FIND:

'CALLPIPE COMMAND XMITMSG 602 "' || needle || '" (APPLID GOP' ,
        'CALLER CLI NOHEADER | GOPCLIUI | VAR NEEDLE'
needle = Translate(Strip(needle))
If needle = "" Then Return

Do i = ko + 1 to ki
    If Index(Translate(menu.i),needle) > 0 Then Do
        ko = i
        Return
        End  /*  If  ..  Do  */
    End  /*  Do  For  */

/*  'CALLPIPE COMMAND XMITMSG 546 (ERRMSG'  CALLER DMS is OK  */
/*  "Target not found"  */
'CALLPIPE COMMAND XMITMSG 546 (APPLID GOP CALLER CLI ERRMSG' ,
        '| STEM MESSAGE. APPEND'

Return



/* ---------------------------------------------------------------- MARK
 *  Save a bookmark referencing this menu,
 *  or  (if in "booklist" mode)  delete the bookmark at the cursor.
 */
MARK:

If fs.tube ^= "" Then Do
    /*  "Can't set bookmarks from this screen."  */
    'CALLPIPE COMMAND XMITMSG 43 (APPLID GOP CALLER CLI ERRMSG' ,
            '| STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

If booklist Then Do
    'CALLPIPE COMMAND XMITMSG 42 I (APPLID GOP NOHEADER' ,
        '| SPEC /i            / 1 1-* NEXT | VAR BOOKMARK.' || i
    If rc = 0 Then
    Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
    If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 42 I' ,
        '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
        /*  "Bookmark" i "deleted."  */
    Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,
        '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

Address "COMMAND" 'GLOBALV SELECT GOPHER GET BOOKMARK.0'
If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0
i = bookmark.0 + 1
bookmark.i = item
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
bookmark.0 = i
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'

If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 41 I' ,
    '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
    /*  "Bookmark" i "saved."  */
          Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,
        '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'

Return



/* ------------------------------------------------------------ BOOKLIST
 *  Call GOPCLI to show the lit of bookmarks.
 */
BOOKLIST:

Address "CMS" 'GOPCLI (BOOKLIST'

Return



/* ----------------------------------------------------------------- FIX
 * Takes an inbound 3270 DS screen address (two bytes)
 * and returns the equivalent byte offset in decimal.
 */
FIX:
Parse Arg o,.
Parse Var o 1 o1 2 o2 3 .
o1 = c2d(o1)
o2 = c2d(o2)
If o1 < 64 Then Return o1 * 256 + o2
           Else Return (o1 // 64) * 64 + (o2 // 64)



/* ---------------------------------------------------------- WRITE_READ
 * Display what we have, then wait for user input and return it.
 */
WRITE_READ: Procedure Expose fs.
Parse Arg ws,wcc,wrt,.
If wcc = "" Then wcc = 'C3'x
/*  If wrt = "" Then wrt = 'C0'x  */
If wrt = "" Then wrt = fs.write
ws = wrt || wcc || ws
'CALLPIPE VAR WS | FULLSCR' fs.tube '| VAR RS'
If rc ^= 0 Then rs = '000000'x
Return rs



/* ----------------------------------------------------------------- SBA
 * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
 * Construct Set Buffer Address order from row and column.
 */

SBA:      Procedure Expose fs.

arg row , col, .
row = Trunc(row)
col = Trunc(col)

/*-----------------------------------------------------------------*/
/* Calculate binary address.                                       */
/*-----------------------------------------------------------------*/

offset = row * fs.scrcols + col
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End

if fs.14bit then return '11'x || d2c(offset,2)

/*-----------------------------------------------------------------*/
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
/*-----------------------------------------------------------------*/

'CALLPIPE var offset'               ,   /* Start with char number.    */
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
                '01-09 C1-C9'       ,   /*   buffer address.          */
                '11-19 D1-D9'       ,   /*                            */
                '22-29 E2-E9'       ,   /*                            */
                '30-39 F0-F9'       ,   /*                            */
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
    '| var offset'                      /* Put back in variable.      */

Return offset



/* --------------------------------------------------------------- FIELD
 * Generate the 3270 DS sequence for extended field attributes
 * (if available).
 */
FIELD:    Procedure Expose fs.
a = '00'x
b = '00'x
c = 'F1'x
i = 1
Do While Arg(i) ^= ""
    Select  /*  at  */
        When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)
        When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)
        When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)
        When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)
        When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)
        When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)
        When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)
        When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x
        When Abbrev("RED",Arg(i),3)         Then c = 'F2'x
        When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x
        When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x
        When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x
        When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x
        When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x
        Otherwise nop
        End  /*  Select  at  */
    i = i + 1
    End  /*  Do  While  */

If  ^fs.color   | ,
    ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)
                Else    Return '2902'x || ,
                               'C0'x   || bitor(a,'40'x) || ,
                               '42'x   || bitor(c,'40'x)



/* ---------------------------------------------------------------- GTAG
 *  Match the gopher data type to a national language  "tag"  string.
 */
GTAG:     Procedure

Parse Arg type

    Select  /*  type  */

        When type = '0' Then _tag = 700
        When type = '1' Then _tag = 701
        When type = '2' Then _tag = 702
        When type = '3' Then _tag = 703
        When type = '4' Then _tag = 704
        When type = '5' Then _tag = 705
        When type = '6' Then _tag = 706
        When type = '7' Then _tag = 707
        When type = '8' Then _tag = 708
        When type = '9' Then _tag = 709
        When type = 's' Then _tag = 767
        When type = 'r' Then _tag = 766
        When type = 'v' Then _tag = 770
        When type = 'i' Then _tag = 757
        When type = 'I' Then _tag = 725
        When type = 'g' Then _tag = 755
        When type = 'M' Then _tag = 729
        When type = 'T' Then _tag = 736

        When type = ':' Then _tag = 710
        When type = ';' Then _tag = 711
        When type = '<' Then _tag = 712

        Otherwise            _tag = 908

        End  /*  Select  type  */

'CALLPIPE COMMAND XMITMSG' _tag 'TYPE (APPLID GOP NOHEADER | VAR TAG'

Return tag



/* ---------------------------------------------------------------- HELP
 *  Invoke CMS HELP for GOPHER BROWSER (the menu browser).
 */
HELP:     Procedure Expose fs. message.

If fs.tube ^= "" Then
    'CALLPIPE COMMAND HELP GOPHER BROWSER (ALL NOSCREEN' ,
        '| GOPCLIFV BROWSER HELP' ,
            '| STEM MESSAGE. APPEND'

Else Do
    Address "COMMAND" 'HELP GOPHER BROWSER'
    Address "COMMAND" 'VMFCLEAR'
    End  /*  Else  Do  */

Return

:READ  GOPCLIUI REXX     A1 TMP200 01/03/93 16:05:24
/*
 *        Name: GOPCLIUI REXX
 *              VM TCP/IP Network GOPHER Client user input
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *       Input: a prompt string
 *      Output: the user's response
 *
 *              Untested with multiples,  but should work that way.
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

/*  fetch fs. stem variable from calling REXX environment  */
'CALLPIPE REXXVARS 1 | DROP | JOIN 1 /,/' ,
        '| CHANGE /n /,/ | CHANGE /,v /,/ 1 | LOCATE /FS./ | VARLOAD'

/*  trouble with plain write,  so fetch current screen contents  */
'CALLPIPE LITERAL 00 | SPEC 1-2 X2C 1' ,
        '| FULLSCR' fs.tube 'CONDREAD | VAR SCREEN'
Parse Var screen 1 aid 2 cursor 4 screen

Do Forever

    'PEEKTO PROMPT'
    If rc ^= 0 Then Leave

    Parse Var prompt prompt ';' preset
    prompt = Strip(prompt)
    preset = Strip(preset)

    /* --------------------------------------------------------- GPROMPT
     *  Present a prompt and read from the Gopher user's screen.
     *  Preset response data may have been supplied.
     */

    prompt = fs.write || 'C3'x || screen || ,
            sba(1,-1) || field("PROT","GREEN") || prompt ,
            || field("HIGH","WHITE") || '13'x || preset || ,
            Copies('00'x,fs.scrcols*2-Length(prompt)-Length(preset)-4) ,
            || field("PROT")

    'CALLPIPE VAR PROMPT | FULLSCR' fs.tube '| VAR RS'
    Parse Var rs With 1 aid 2 . 4 rs

    If  aid = '7D'x   /* enter */   Then Do
        Parse Var rs With . '11'x rs
        rs = Substr(rs,3)
        If rs = "" Then rs = preset
        'OUTPUT' rs
        End  /*  If  ..  Do  */

    Else 'OUTPUT'

    'CALLPIPE VAR CURSOR | SPEC /00C311/ X2C 1 1.2 NEXT' ,
            '/13/ X2C NEXT | FULLSCR' fs.tube 'NOREAD | HOLE'

    'READTO'

    End  /*  Do  Forever  */

Exit rc * (rc ^= 12)




/* ----------------------------------------------------------------- SBA
 * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
 * Construct Set Buffer Address order from row and column.
 */

SBA:      Procedure Expose fs.

arg row , col, .
row = Trunc(row)
col = Trunc(col)

/*-----------------------------------------------------------------*/
/* Calculate binary address.                                       */
/*-----------------------------------------------------------------*/

offset = row * fs.scrcols + col
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End

if fs.14bit then return '11'x || d2c(offset,2)

/*-----------------------------------------------------------------*/
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
/*-----------------------------------------------------------------*/

'CALLPIPE var offset'               ,   /* Start with char number.    */
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
                '01-09 C1-C9'       ,   /*   buffer address.          */
                '11-19 D1-D9'       ,   /*                            */
                '22-29 E2-E9'       ,   /*                            */
                '30-39 F0-F9'       ,   /*                            */
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
    '| var offset'                      /* Put back in variable.      */

Return offset



/* --------------------------------------------------------------- FIELD
 * Generate the 3270 DS sequence for extended field attributes
 * (if available).
 */
FIELD:    Procedure Expose fs.
a = '00'x
b = '00'x
c = 'F1'x
i = 1
Do While Arg(i) ^= ""
    Select  /*  at  */
        When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)
        When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)
        When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)
        When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)
        When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)
        When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)
        When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)
        When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x
        When Abbrev("RED",Arg(i),3)         Then c = 'F2'x
        When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x
        When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x
        When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x
        When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x
        When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x
        Otherwise nop
        End  /*  Select  at  */
    i = i + 1
    End  /*  Do  While  */

If  ^fs.color   | ,
    ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)
                Else    Return '2902'x || ,
                               'C0'x   || bitor(a,'40'x) || ,
                               '42'x   || bitor(c,'40'x)

:READ  GOPCLITX REXX     A1 TMP200 01/24/93 23:28:42
/*
 *        Name: GOPCLITX REXX
 *              VM TCP/IP Network GOPHER Client plain-text processor
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *       Input: raw ASCII text
 *      Output: plain (EBCDIC) text
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

/*  Trace "OFF"  */

/*  sync with input so that 'CALLPIPE COMMAND' will work  */
'PEEKTO'

'CALLPIPE COMMAND GLOBALV SELECT GOPHER GET GOPHER'
If gopher = "" Then gopher = "Gopher"

'ADDPIPE *: | DEBLOCK LINEND 0A | DROP LAST 1' ,
        '| CHANGE' '000D002000'x '| TCPA2E' gopher '| *.INPUT:'

/*
 *        Name: DROPDOTS REXX
 *              drop trailing lines consisting of only "."
 *              (typically used for end-of-file indication)
 *        Date: 1992-Apr-18, 20
 */

dots = 0
'READTO LINE'
Do While rc = 0
    If Left(line,1) = "." Then Do
        dots = dots + 1
        line.dots = line
        End  /*  If  ..  Do  */
    Else Do
        Do i = 1 to dots;  'OUTPUT' line.i;  End
        dots = 0
        'OUTPUT' line
        End  /*  Else  Do  */
    'READTO LINE'
    End  /*  Do  While  */

Exit

:READ  GOPCLIFV REXX     A1 TMP200 01/21/93 13:16:41
/*
 *        Name: GOPCLIFV REXX
 *              VM TCP/IP Network GOPHER Client file viewer
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *       Input: a plain-text file to view
 *      Output: zero or more information or error messages
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Trace "OFF"

Parse Arg args '(' . ')' .

/*  verify availability of input  */
'PEEKTO'
If rc ^= 0 & rc ^= 12 Then Exit rc
If rc = 12 Then Do  /*  Warning: file is empty  */
    'CALLPIPE COMMAND XMITMSG 559 (ERRMSG | *:'
    Exit
    End  /*  If  ..  Do  */

Address "COMMAND" 'GLOBALV SELECT GOPHER GET' ,
        'GOPHER PROGID VIEWER ITEM'
quit = 0

Parse Var item name '05'x path '05'x host '05'x port '05'x xtra
Parse Var name 1 . 2 name       /*  discard type indicator byte  */
Parse Var path 1 . 2 path       /*  discard type indicarot byte  */
If name = "" Then name = args

/*  fetch fs. stem variable from GlobalVs  */
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
If rc ^= 0 Then Address "COMMAND" 'EXEC GOPCLINI'
If ^Datatype(fs.tube,'X') Then fs.tube = ""

message.0 = 0
command = ""

Select  /*  viewer  */
    When viewer = ""         Then Call BUILT_IN
    When viewer = "XEDIT"    Then Call XEDIT
    When viewer = "BROWSE"   Then Call BROWSE
    Otherwise                     Call ANYOTHER
    /*
        handle disk-full conditions!
     */
    End  /*  Select  viewer  */
vrc = rc

'CALLPIPE STEM MESSAGE. | *:'

Parse Upper Var command cmdverb .
Address "COMMAND" 'GLOBALV SELECT GOPHER PUT' ,
        'COMMAND CMDVERB'

Exit vrc


/* ============================================================ BUILT_IN
 */
BUILT_IN:

/*  read the file from the preceding stage  */
'CALLPIPE *: | EXPAND | XLATE OUTPUT | XLATE *-* 00-3F 40 FF 40' ,
        '| DEBLOCK FIXED' fs.scrcols + 1 '| STEM FILE.'

/*  display the file and process user's response  */
row = 3;        col = 0
ki = file.0;    kl = fs.scrrows - 5;    ko = 1
needle = ""     /*  may be re-used within this context  */

'CALLPIPE COMMAND XMITMSG 614 (APPLID GOP' ,
        'NOCOMP NOHEADER | STEM HELP.'

'CALLPIPE COMMAND XMITMSG 5 (APPLID GOP NOHEADER | VAR MORE'

Do Forever

    /*  write the program title line  */
    wscreen = sba(0,-1) || field("BLUE","PROT") || sba(0,0) || progid ,
                        || sba(0,fs.scrcols-Length(host)-1) || host

    /*  no SBA for status because it follows host immediately  */
    If message.0 < 1 Then Do
    wscreen = wscreen   || field("PROT") || Left(ko || '/' || ki, 11)
    If ko + kl <= ki Then
    wscreen = wscreen   || field("WHITE","HIGH","PROT") || more
        End  /*  If  ..  Do  */

    /*  don't write status or name if they'll be overlaid  */
    If message.0 < 2 Then
    wscreen = wscreen   || sba(2,(fs.scrcols-Length(name))/2) ,
                        || field("WHITE","PROT") || name

    /*  write as many message lines as needed  */
    If message.0 > 0 Then Do
        Do i = 1 to message.0
            wscreen = wscreen || sba(i,-1) ,
                || field("RED","HIGH","PROT") || message.i
            End  /*  Do  For  */
        message.0 = 0
        End  /*  If  ..  Do  */
    /*  we should probably limit that count  */

    /*  write those PFkey settings  */
    wscreen = wscreen   || sba(fs.scrrows-2,-1) ,
                        || field("BLUE","PROT") ,
                        || help.1 ,
                        || sba(fs.scrrows-1,-1) ,
                        || field("BLUE","PROT") ,
                        || help.2

    i = 1; j = ko
    Do While i <= kl & j <= ki

/*      'CALLPIPE VAR FILE.' || i '| XLATE OUTPUT' ,
            '| XLATE *-* 00-3F 40 FF 40 | VAR _LINE'                  */

        wscreen = wscreen || sba(i+2,-1) || field("GREEN","PROT")
        wscreen = wscreen || file.j
        i = i + 1;  j = j + 1
        End

    rscreen = write_read(wscreen || sba(row,col) || '13'x)
    Parse Var rscreen 1 aid 2 offset . '11'x rscreen
    offset = fix(offset)
    row = offset % fs.scrcols; col = offset // fs.scrcols

    /*  keep the  row/col  values within bounds  */
    row = 3     /* just reset it */
    col = 0     /* just reset it */

    Select /* aid */
        When  aid = '7D'x   /* enter */ Then nop
        When  aid = 'F2'x   /*  PF2  */ | ,
              aid = 'C2'x   /*  PF14 */ | ,
              aid = '7B'x   /*  PF11 */ | ,
              aid = '4B'x   /*  PF23 */ Then Call SUBXEDIT
        When  aid = 'F3'x   /*  PF3  */ | ,
              aid = 'C3'x   /*  PF15 */ Then Leave
        When  aid = 'F4'x   /*  PF4  */ | ,
              aid = 'C4'x   /*  PF16 */ Then Call PRINT
        When  aid = 'F5'x   /*  PF5  */ | ,
              aid = 'C5'x   /*  PF17 */ Then Call SAVE
        When  aid = 'F6'x   /*  PF6  */ | ,
              aid = 'C6'x   /*  PF18 */ Then Call FIND
        When  aid = 'F7'x   /*  PF7  */ | ,
              aid = 'C7'x   /*  PF19 */ Then ko = Max(ko-kl+1,1)
        When  aid = 'F8'x   /*  PF8  */ | ,
              aid = 'C8'x   /*  PF20 */ Then ko = Min(ko+kl-1,ki)
        When  aid = 'F9'x   /*  PF9  */ | ,
              aid = 'C9'x   /*  PF21 */ Then  Call  MARK
        When  aid = '7A'x   /*  PF10 */ | ,
              aid = '4A'x   /*  PF22 */ Then  Call  BOOKLIST
        When  aid = '6D'x   /* clear */ | ,
              aid = '6E'x   /*  PA2  */ Then Do
            row = 3; col = 0; ko = 1
            End  /*  When ..  Do  */
        When  aid = '7C'x   /*  PF12 */ | ,
              aid = '4C'x   /*  PF24 */ | ,
              aid = 'F0'x   /* sysrq */ | ,
              aid = '6C'x   /*  PA1  */ Then  quit = 1
        When  aid = 'F1'x   /*  PF1  */ | ,
              aid = 'C1'x   /*  PF13 */ Then  Call  HELP
        When  aid = '00'x               Then Do
            /*  I/O error on screen  */
            'CALLPIPE COMMAND XMITMSG 925 (APPLID GOP' ,
                    'CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
              Leave
              End
        Otherwise  Do   /*  Undefined PFkey/PAkey  */
            'CALLPIPE COMMAND XMITMSG 657 "' || c2x(aid) || '"' ,
                '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
            End  /*  Otherwise  Do  */
        End  /*  Select  aid  */

    If quit Then Leave

    End  /*  Do  Forever  */

If quit Then command = "QUIT"

Return



/* =============================================================== XEDIT
 *  Take the "file" from the input stream and pass it to CMS XEDIT.
 */
XEDIT:

If fs.tube ^= "" Then Do
    /*  "Can't run XEDIT on this terminal."  */
    'CALLPIPE COMMAND XMITMSG 512 "XEDIT"' ,
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

/*  stash this in a temporary file  */
'CALLPIPE *: | > VMGOPHER DOCUMENT A3'

/*  what's the real name of the file?  */
Parse Value gopclifi(path) With fn ft .
Push "COMMAND SET FNAME" fn
Push "COMMAND SET FTYPE" ft
Push "COMMAND SET FMODE A1"

/*  now invoke XEDIT  */
'CALLPIPE COMMAND STATE GOPXEDPR XEDIT *'
If rc = 0 Then Address "COMMAND" ,
                'XEDIT VMGOPHER DOCUMENT A (PROFILE GOPXEDPR'
          Else Address "COMMAND" ,
                'XEDIT VMGOPHER DOCUMENT A'

Return



/* ============================================================== BROWSE
 *  Take the "file" from the input stream and pass it to CMS BROWSE.
 */
BROWSE:

If fs.tube ^= "" Then Do
    /*  "Can't run BROWSE on this terminal."  */
    'CALLPIPE COMMAND XMITMSG 512 "BROWSE"' ,
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

Parse Value gopclifi(path) With fn ft .
filespec = fn ft 'A'

'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'
If  rc ^= 0 & rc ^= 28 & rc ^= 20  Then Return
If  rc = 0 | rc = 20  Then Do
    fn = "VMGOPHER"
    ft = "DOCUMENT"
    End  /*  If  ..  Do  */
message.0 = 0

/*  stash this in a temporary file  */
'CALLPIPE *: | >' fn ft 'A3'

/* stash this in a temporary file and invoke BROWSE */
Address "COMMAND" 'BROWSE' filespec

Return



/* ============================================================ ANYOTHER
 *  View the file with some unknown text editor or file browser.
 */
ANYOTHER:

If fs.tube ^= "" Then Do
    /*  "Can't run" viewer "on this terminal."  */
    'CALLPIPE COMMAND XMITMSG 512 VIEWER' ,
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

Parse Value gopclifi(path) With fn ft .
filespec = fn ft 'A'

'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'
If  rc ^= 0 & rc ^= 28 & rc ^= 20  Then Return
If  rc = 0 | rc = 20  Then Do
    fn = "VMGOPHER"
    ft = "DOCUMENT"
    End  /*  If  ..  Do  */
message.0 = 0

/*  stash this in a temporary file  */
'CALLPIPE *: | >' fn ft 'A3'

/* stash this in a temporary file and invoke the viewer  */
'CALLPIPE CMS' viewer filespec '| CONSOLE'

Return



/* ---------------------------------------------------------------- HELP
 * Invoke CMS HELP passing any supplied argument (context sensitive).
 */
HELP:     Procedure Expose fs. message.

If fs.tube ^= "" Then
    'CALLPIPE COMMAND HELP GOPHER VIEWER (ALL' ,
        '| GOPCLIFV VIEWER HELP' ,
            '| STEM MESSAGE. APPEND'

Else Do
    'CALLPIPE COMMAND HELP GOPHER VIEWER'
    Address "COMMAND" 'VMFCLEAR'
    End  /*  Else  Do  */

Return



/* ------------------------------------------------------------ SUBXEDIT
 *  Take the file in storage and pass it to CMS XEDIT.
 */
SUBXEDIT:

If fs.tube ^= "" Then Do
    /*  "Can't run XEDIT on this terminal."  */
    'CALLPIPE COMMAND XMITMSG 512 "XEDIT"' ,
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

/*  stash this in a temporary file  */
'CALLPIPE STEM FILE. | > VMGOPHER DOCUMENT A3'

/*  what's the real name of the file?  */
Parse Value gopclifi(path) With fn ft .
Push "COMMAND SET FNAME" fn
Push "COMMAND SET FTYPE" ft
Push "COMMAND SET FMODE A1"

/*  now invoke XEDIT  */
'CALLPIPE COMMAND STATE GOPXEDPR XEDIT *'
If rc = 0 Then Address "COMMAND" ,
                'XEDIT VMGOPHER DOCUMENT A (PROFILE GOPXEDPR'
          Else Address "COMMAND" ,
                'XEDIT VMGOPHER DOCUMENT A'

Return



/* --------------------------------------------------------------- PRINT
 *  Take the current "file" in context and send it to the user's
 *  virtual printer.  Printer may be SPOOLed CONTinuous.
 */
PRINT:

If fs.tube ^= "" Then Do
    /*  "Can't PRINT from this terminal."  */
    'CALLPIPE COMMAND XMITMSG 507 (APPLID GOP CALLER FVW ERRMSG' ,
            '| STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

'CALLPIPE STEM FILE. | PRINT (TITLE' name '| STEM MESSAGE. APPEND'

Return



/* ---------------------------------------------------------------- SAVE
 * Save the current file being viewed to the user's A disk.
 */
SAVE:

If fs.tube ^= "" Then Do
    Call MESSAGE "Can't SAVE files via this terminal."
    Return
    End /* If .. Do */

Parse Value gopclifi(path) With fn ft .
filespec = fn ft 'A'

'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'
If rc = 0 Then Do
    'CALLPIPE COMMAND XMITMSG 24 FILESPEC' ,
        '| SPLIT AT /;/ | TAKE | STEM MESSAGE.'
    Return
    End  /*  If  ..  Do  */
If rc ^= 28 Then Return
message.0 = 0

'CALLPIPE STEM FILE. | >' filespec
If rc = 0 Then Do
    /*  Creating new file:  */
    'CALLPIPE COMMAND XMITMSG 571 | STEM MESSAGE. APPEND'
    message.1 = message.1 filespec
/*  Call message "Created" filespec "from" path  */
    End  /*  If  ..  Do  */

Return



/* ---------------------------------------------------------------- FIND
 *  Find a particular string within the file being viewed.
 */
FIND:

'CALLPIPE COMMAND XMITMSG 602 "' || needle || '" (APPLID GOP' ,
        'CALLER MNU NOHEADER | GOPCLIUI | VAR NEEDLE'
needle = Translate(Strip(needle))
If needle = "" Then Return

Do i = ko + 1 to ki
    If Index(Translate(file.i),needle) > 0 Then Do
        ko = i
        Return
        End  /*  If  ..  Do  */
    End  /*  Do  For  */

/*  'CALLPIPE COMMAND XMITMSG 546 (ERRMSG'  CALLER DMS is OK  */
/*  "Target not found"  */
'CALLPIPE COMMAND XMITMSG 546 (APPLID GOP CALLER MNU ERRMSG' ,
        '| STEM MESSAGE. APPEND'

Return




/* ---------------------------------------------------------------- MARK
 *  Save a book mark referencing this file.
 */
MARK:

If fs.tube ^= "" Then Do
    /*  "Can't set bookmarks from this screen."  */
    'CALLPIPE COMMAND XMITMSG 43 (APPLID GOP CALLER FVW ERRMSG' ,
            '| STEM MESSAGE. APPEND'
    Return
    End /* If .. Do */

Address "COMMAND" 'GLOBALV SELECT GOPHER GET BOOKMARK.0'
If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0
i = bookmark.0 + 1
bookmark.i = item
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
bookmark.0 = i
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'

If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 41 I' ,
    '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
    /*  "Bookmark" i "saved."  */
          Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,
        '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'

Return



/* ------------------------------------------------------------ BOOKLIST
 *  Call GOPCLI to show the lit of bookmarks.
 */
BOOKLIST:

Address "CMS" 'GOPCLI (BOOKLIST'

Return



/* ----------------------------------------------------------------- FIX
 * Takes an inbound 3270 DS screen address (two bytes)
 * and returns the equivalent byte offset in decimal.
 */
FIX:
Parse Arg o,.
Parse Var o 1 o1 2 o2 3 .
o1 = c2d(o1)
o2 = c2d(o2)
If o1 < 64 Then Return o1 * 256 + o2
           Else Return (o1 // 64) * 64 + (o2 // 64)



/* ---------------------------------------------------------- WRITE_READ
 * Display what we have, then wait for user input and return it.
 */
WRITE_READ: Procedure Expose fs.
Parse Arg ws,wcc,wrt,.
If wcc = "" Then wcc = 'C3'x
/*  If wrt = "" Then wrt = 'C0'x  */
If wrt = "" Then wrt = fs.write
ws = wrt || wcc || ws
'CALLPIPE VAR WS | FULLSCR' fs.tube '| VAR RS'
If rc ^= 0 Then rs = '000000'x
Return rs



/* ----------------------------------------------------------------- SBA
 * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
 * Construct Set Buffer Address order from row and column.
 */

SBA:      Procedure Expose fs.

arg row , col, .
row = Trunc(row)
col = Trunc(col)

/*-----------------------------------------------------------------*/
/* Calculate binary address.                                       */
/*-----------------------------------------------------------------*/

offset = row * fs.scrcols + col
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End

if fs.14bit then return '11'x || d2c(offset,2)

/*-----------------------------------------------------------------*/
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
/*-----------------------------------------------------------------*/

'CALLPIPE var offset'               ,   /* Start with char number.    */
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
                '01-09 C1-C9'       ,   /*   buffer address.          */
                '11-19 D1-D9'       ,   /*                            */
                '22-29 E2-E9'       ,   /*                            */
                '30-39 F0-F9'       ,   /*                            */
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
    '| var offset'                      /* Put back in variable.      */

Return offset



/* --------------------------------------------------------------- FIELD
 * Generate the 3270 DS sequence for extended field attributes
 * (if available).
 */
FIELD:    Procedure Expose fs.
a = '00'x
b = '00'x
c = 'F1'x
i = 1
Do While Arg(i) ^= ""
    Select  /*  at  */
        When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)
        When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)
        When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)
        When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)
        When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)
        When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)
        When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)
        When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x
        When Abbrev("RED",Arg(i),3)         Then c = 'F2'x
        When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x
        When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x
        When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x
        When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x
        When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x
        Otherwise nop
        End  /*  Select  at  */
    i = i + 1
    End  /*  Do  While  */

If  ^fs.color   | ,
    ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)
                Else    Return '2902'x || ,
                               'C0'x   || bitor(a,'40'x) || ,
                               '42'x   || bitor(c,'40'x)

:READ  GOPCLIGV REXX     A1 TMP200 12/27/92 05:30:06
/*
 *        Name: GOPCLIGV REXX
 *              VM TCP/IP Network GOPHER Client graphics viewer
 *              This file is part of CMS Gopher and not part of VMGIF.
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-23
 *
 *        Note: the first record must be at least long enough
 *              to identify the graphics format (magic number)
 */

/*
 *      Copyright 1992 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

/*  Trace "OFF"  */

'PEEKTO RECORD'
Select
    When Left(record,5) = '4749463837'x Then Signal GIF
    Otherwise 'OUTPUT' "unknown graphics format"
    End  /*  Select  */

Exit rc * (rc ^= 12)



/* ------------------------------------------------------------------ */
GIF:

/*  verify that we have the VMGIF disk accessed  */
'CALLPIPE CMS STATE VMGIF MODULE * | *:'
If rc ^= 0 Then Exit rc

/*  try to stash the input stream in a temp file  */
'CALLPIPE *: | > TEMP#GIF GIF A3'
If rc ^= 0 Then Do
    grc = rc
    'CALLPIPE COMMAND ERASE TEMP#GIF GIF A'
    Exit grc
    End  /*  If  ..  Do  */

/*  ensure that the right libraries are GLOBALed  */
/*  (I loathe doing this)  */
'CALLPIPE COMMAND QUERY TXTLIB' ,
    '| STRIP LEADING STRING /TXTLIB   = / | JOIN * | VAR TXTLIB'
Upper txtlib;   If Strip(txtlib) = "NONE" Then txtlib = ""
'CALLPIPE COMMAND GLOBAL TXTLIB ADMPLIB ADMGLIB' txtlib

/*  now run VMGIF  */
'CALLPIPE CMS VMGIF -em5 TEMP#GIF | *:'; grc = rc

/*  restore GLOBALed libraries  */
'CALLPIPE COMMAND GLOBAL TXTLIB' txtlib

Exit grc

:READ  GOPCLIFI EXEC     A1 TMP200 01/15/93 12:03:27
/*
 *        Name: GOPCLIFI EXEC (function)
 *              returns a CMS fileid from a gopher path
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-10, 1993-Jan-15
 *
 *              This file is part of CMS Gopher.
 */

Parse Source . call . . . arg0 .
If call ^= "FUNCTION" Then Do
    Say "Usage:" arg0 || "()"
    Exit
    End

Parse Arg path
Parse Value Reverse(path) With name '/' path
Parse Value Reverse(name) With name ',' . ';' vers

/*  input/output tables are built piecemeal to circumvent     *
 *  the 500 byte clause limit in older interpreters           */
i   =    '000102030405060708090A0B0C0D0E0F'x || ,
         '101112131415161718191A1B1C1D1E1F'x || ,
         '202122232425262728292A2B2C2D2E2F'x || ,
         '303132333435363738393A3B3C3D3E3F'x

i = i || '404142434445464748494A4B4C4D4E4F'x || ,
         '505152535455565758595A5B5C5D5E5F'x || ,
         '606162636465666768696A6B6C6D6E6F'x || ,
         '707172737475767778797A7B7C7D7E7F'x

i = i || '808182838485868788898A8B8C8D8E8F'x || ,
         '909192939495969798999A9B9C9D9E9F'x || ,
         'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x || ,
         'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x

i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x || ,
         'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x || ,
         'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x || ,
         'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x

o   =    '40404040404040404040404040404040'x || ,
         '40404040404040404040404040404040'x || ,
         '40404040404040404040404040404040'x || ,
         '40404040404040404040404040404040'x

o = o || '407C7C7C7C7C7C7C7C7C7C407C7C4E7C'x || ,
         '7C7C7C7C7C7C7C7C7C7C7C5B7C7C7C7C'x || ,
         '607C7C7C7C7C7C7C7C7C7C7C6C6D7C7C'x || ,
         '7C7C7C7C7C7C7C7C7C7C7A7B7C7C7C7C'x

o = o || '7CC1C2C3C4C5C6C7C8C97C7C7C7C7C7C'x || ,
         '7CD1D2D3D4D5D6D7D8D97C7C7C7C7C7C'x || ,
         '7C7CE2E3E4E5E6E7E8E97C7C7C7C7C7C'x || ,
         '7C7C7C7C7C7C7C7C7C7C7C7C7C7C7C7C'x

o = o || '7CC1C2C3C4C5C6C7C8C97C7C7C7C7C7C'x || ,
         '7CD1D2D3D4D5D6D7D8D97C7C7C7C7C7C'x || ,
         '7C7CE2E3E4E5E6E7E8E97C7C7C7C7C7C'x || ,
         'F0F1F2F3F4F5F6F7F8F97C7C7C7C7C7C'x

Parse Upper Value Translate(name,o,i) With fn ft .
If fn = "" Then fn = "VMGOPHER"
If ft = "" Then ft = "DOCUMENT"
Return fn ft

:READ  GVM      EXEC     A1 TMP200 04/18/92 18:08:27
/*
 *        Name: GVM EXEC
 *              for the DIALed GOPHER service virtual machine
 *              (not to be confused with GOPHERD service machine)
 *      Author: Rick Troth, Rice Univ, I/S VM Systems Support
 *        Date: 1992-Mar-06, and prior
 *
 *        Note:
 *              This EXEC has been tested with VM/SP R5.
 *              It is not guaranteed to work with anything else,
 *              and probably  *will not*  work with VM/XA and ESA.
 *
 *              Similarity between the names PVM and GVM is intentional.
 */

host = "localhost"
port = 70
tube = 420

Address "COMMAND"

/* Find my VMBLOK */
Parse Value Diag(08,'QUERY USERID') With userid . '15'x .
'CP QUERY USERID'
Parse Value Diag(08,'LOCATE' userid) With . . vmbaddr . '15'x .
'CP LOCATE' userid
If rc ^= 0 Then Exit rc
vmbaddr = strip(vmbaddr)

'CP DEFINE GRAF' tube
/* Trap I/O traces and wait for someone to DIAL */
'IUCVTRAP ON ALL'
'CP SET CPCONIO IUCV'
'CP TRACE I/O RUN'
Do Forever      /* or at least until we get DIALed to */
    'IUCVTRAP GRAB (WAIT'
    Parse Pull . "I/O" iodevice .
    If x2d(iodevice) = x2d(tube) Then Leave
    End /* Do While */
'CP TRACE END'
'CP SET CPCONIO OFF'
'IUCVTRAP OFF'

Do i = 0 to 99
    slaveid = "GOPHER" || Right(i,2,"0")
    Parse Value Diagrc(08,'QUERY USER' slaveid),
        With 1 rc 10 . 17 rs '15'x .
    If rc = 45 Then Leave
    End
/* Change my userid to slaveid */
'CP STCP' d2x(x2d(vmbaddr)+272) c2x(left(slaveid,4)) c2x(right(slaveid,4))

/* Now fire-up another server */
'CP AUTOLOG' userid 'ALL'

Parse Value Diag(08,'QUERY VIRTUAL' tube) With . . "ON" . graf '15'x .

'EXEC GOPHER' host port '(TUBE' tube
Say "GOPHER returned" rc

'CP DETACH' tube
/* 'CP HOST RESET' graf 'HOLD' */
'CP SLEEP 1 SEC'
Say 'CP DISABLE' graf
'CP DISABLE' graf
'CP SLEEP 1 SEC'
Say 'CP ENABLE' graf
'CP ENABLE' graf
'CP LOGOFF'

/* The TRACE string we're looking for is:                             *
 * "*** EF8818 I/O   0420 ==> EF0C40  CSW 0400"                       */
:READ  GVM      DIRECT   A1 TMP200 01/06/93 14:06:49
USER     GVM      pppppppp 2M       4M       ABCDEFG                    GVM00010
*                                                                       GVM00020
* This defines virtual machine GVM. Similarity in name to PVM           GVM00030
* is intentional. What you do is "DIAL GVM" from the VM logo,           GVM00040
* and GVM renames itself to one of GOPHER00 thru GOPHER09 (or more)     GVM00050
* and then runs GOPHER (GOPCLI) in "dialed mode".                       GVM00060
*                                                                       GVM00070
 INCLUDE  CMS                                                           GVM00080
*:name.DIALed Gopher service virtual machine :list.GOPHERD              GVM00090
* (at Rice, we extract records begining with  "*:"  nightly from        GVM00100
* CP Directory to create a  <node> NAMES  file on the public X disk)    GVM00110
 ACCOUNT  aaaaaaaa dddd                                                 GVM00120
 ACIGROUP gggggggg                                                      GVM00130
 LINK     GOPHERD   191      191     RR                                 GVM00140
*                                                                       GVM00150
USER     GOPHER00 NOLOG                                                 GVM00160
USER     GOPHER01 NOLOG                                                 GVM00170
USER     GOPHER02 NOLOG                                                 GVM00180
USER     GOPHER03 NOLOG                                                 GVM00190
USER     GOPHER04 NOLOG                                                 GVM00200
USER     GOPHER05 NOLOG                                                 GVM00210
USER     GOPHER06 NOLOG                                                 GVM00220
USER     GOPHER07 NOLOG                                                 GVM00230
USER     GOPHER08 NOLOG                                                 GVM00240
USER     GOPHER09 NOLOG                                                 GVM00250
*                                                                       GVM00260
:READ  GOPHERD  EXEC     A1 TMP200 01/20/93 18:48:43
/*                                                                    *
 *        Name: PROFILE/GOPHPROF/GOPHERD EXEC                         *
 *              initialization for the GopherD service virt machine   *
 *      Author: Rick Troth, Rice University, Information Systems      *
 *        Date: 1993-Jan-20                                           *
 *                                                                    */

Address "COMMAND"

/*  do any LINK and ACCESSes you need  */

'EXEC GOPSRV'
Exit rc

:READ  GOPHERD  CONFIG   A1 TMP200 01/20/93 18:34:51
*
*         Name: GOPHERD CONFIG
*               CMS Gopher Server 2.4 configuration file
*       Author: Rick Troth, Rice University, Information Systems
*         Date: 1993-Jan-18
*
*      Changes: -none-
*
* send logging information to the console
*   and then also to the printer
LOGPIPE=CONSOLE | SPEC .09. X2C 1 1-* NEXT | URO 00E
*
:READ  GOPSRV   EXEC     A1 TMP200 01/22/93 14:25:57
/*
 *        Name: GOPSRV EXEC
 *              A CMS-based Gopher Server
 *              Based on the original, GOPHERD EXEC, from 2.3.
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Apr-21, Aug-07, Oct-14, Dec-11, 1993-Jan-15
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

/*
 *       Calls:
 *              GOPSRVLS REXX     -- to read files and menus
 *              GOPSRVRP REXX     -- to resolve gopher paths
 *              GOPSRVMB REXX     -- to build menus for the client
 *
 *        Note: this program does *not* use RXSOCKET's translation
 *              option.   Translation between ASCII and EBCDIC
 *              is determined by the type of file requested.
 */

progid = "CMS Gopher 2.4.0 server"
gopher = "Gopher"
timeout = 5

Parse Source . . . . . arg0 .
argo = arg0 || ':'
Parse Upper Arg root port . '(' . ')' .

Address "COMMAND"

'SET LANGUAGE (ADD GOP USER'

host = "localhost"      /*  this will be reset to the actual name of  *
                         *  this host after RXSOCKET is initialized.  */

    stdin  = 0
    stdout = 1
    stderr = 2

Say argo progid "starting"

logpipe = "CONSOLE"
_root = Userid()
_port = 70
'PIPE < GOPHERD CONFIG * | STEM CONFIG.'
If rc = 0 Then
Do i = 1 to config.0
    If Left(config.i,1) = '*' Then Iterate
    If Left(config.i,1) = '#' Then Iterate
    If Index(config.i,'=') = 0 Then Iterate
    Parse Var config.i var '=' val
    Upper var
    Select  /*  var  */
        When  Abbrev("LOGPIPE",var,3)   Then  logpipe = val
        When  Abbrev("ROOT",var,4)      Then  _root = val
        When  Abbrev("PORT",var,4)      Then  _port = val
        Otherwise 'XMITMSG 2 VAR (ERRMSG'
        End  /*  Select  var  */
    End  /*  Do  For  */

If root = "" Then root = _root
If port = "" Then port = _port

If ^Datatype(port,'N') Then Do
    /*  "Gopher TCP/IP service port must be numeric."  */
    'XMITMSG 126 (APPLID GOP CALLER SRV ERRMSG'
    Exit 24
    End  /*  If  ..  Do  */

/*
 *   Initialize RXSOCKET
 */
maxdesc = Socket('Initialize', gopher)
If maxdesc = "-1" Then Do
    Say argo tcperror()
    Exit -1
    End  /*  If  ..  Do  */
Say argo "RXSOCKET Initialized for" maxdesc "descriptors"


/*
 *   Request the name of this host
 */
rc = Socket('GetHostName', 'HOST')
If rc = "-1" Then Do
    Say argo tcperror()
    Exit -1
    End  /*  If  ..  Do  */
Say argo "LocalHost =" host


/*
 *   Request a new socket descriptor (TCP protocol)
 */
socket = Socket('Socket', 'AF_INET', 'Sock_Stream')
If socket = "-1" Then Do
    Say argo tcperror()
    Exit -1
    End  /*  If  ..  Do  */
Say argo "Primary socket =" socket


/*
 *   Set this socket to non-blocking mode
 */
rc = Socket('Ioctl', socket, 'FIONBIO', 1)
If rc = "-1" Then
    Say argo tcperror()


/*
 *
 */
name = AF_INET || Htons(port)

rc = Socket('Bind', socket, name)
If rc = "-1" Then Do
    Say argo tcperror()
    Exit -1
    End  /*  If  ..  Do  */
Say argo "Bound to port" port


/*
 *
 */
rc = Socket('Listen', socket, maxdesc)
If rc = "-1" Then Do
    Say argo tcperror()
    Exit -1
    End  /*  If  ..  Do  */
/*  Say argo "Listening ..."  */

/*  UNIX and VMS style logging:  */
Parse Value Date('S') With 1 yy 5 mm 7 dd 9 .
day = Left(Date('W'),3)
mon = Left(Date('M'),3)
time = Time()
userid = Userid()
/*  "Starting gopher daemon" Userid()  */
'PIPE COMMAND XMITMSG 120 DAY MON DD TIME YY HOST USERID' ,
        '(APPLID GOP CALLER SRV ERRMSG |' logpipe

Say argo progid "waiting for a connection"

'GLOBALV SELECT GOPHERD PUT HOST PORT ROOT'

Do Forever

    rc = FD_ZERO('readmask')            /* must be reset each time */
    rc = FD_SET(socket, 'readmask')
    rc = FD_SET(stdin, 'readmask')

    Say "*"     /* waiting */
    rc = Socket('Select', socket + 1, 'readmask', 0, 0, 0)
    If rc = "-1" Then Do
        Say argo tcperror()
        Leave
        End  /*  If  ..  Do  */

    If FD_ISSET(stdin, 'readmask') = 1 Then Leave
    If FD_ISSET(socket, 'readmask') ^= 1 Then Iterate

    /*
     *
     */
    ns = Socket('Accept', socket, 'CLIENT')
    If ns = "-1" Then Do
        Say argo tcperror()
        Leave
        End  /*  If  ..  Do  */

    Say argo "Accepted" ns "at" Time() "client" c2x(client)
    Parse Var client . 5 r1 +1 r2 +1 r3 +1 r4 +1 .
    cipa = c2d(r1) || "." || c2d(r2) || "." || ,
           c2d(r3) || "." || c2d(r4)
    /*  Say argo "Client's IP address is" cipa  */

    /*  UNIX and VMS style logging:  */
    Parse Value Date('S') With 1 yyyy 5 mm 7 dd 9 .
    day = Left(Date('W'),3)
    mon = Left(Date('M'),3)
    time = Time()

    /*
     *   Loop, reading the query line from the client.
     */
    path = ""
    Do Forever

        rc = FD_ZERO('readmask')        /* must be reset each time */
        rc = FD_SET(ns, 'readmask')

        rc = Socket('Select', ns + 1, 'readmask', 0, 0, timeout)
        If rc = "-1" Then Do
            Say argo tcperror()
            Exit -1
            End  /*  If  ..  Do  */

        If FD_ISSET(ns, 'readmask') ^= 1 Then Leave

        pack = ""
        bytes_in = Socket('Read', ns, 'PACK')
        If bytes_in = "-1" Then
            Say argo tcperror()
        If bytes_in < 1 Then Leave
        If Index(pack,'0A'x) > 0 Then Leave /* ASCII LF */
        If Index(pack,'0D'x) > 0 Then Leave /* ASCII CR */
        path = path || pack
    End
    path = path || pack

    Parse Var path path '0A'x .     /* ASCII LF */
    Parse Var path path '0D'x .     /* ASCII CR */
    'PIPE VAR PATH | A2E | VAR PATH'

    /*  refresh disk access  (same procedure as used by GONE EXEC)  */
    'PIPE CMS QUERY DISK | DROP | STEM STEM.'
    Do i = 1 to stem.0
        Parse Var stem.i . 8 va 12 fm .
        If Left(va,3) = "DIR" Then Iterate
        'DISKWRIT' Left(fm,1)
        If rc = 1 Then 'ACCESS' va fm
        End  /*  Do  For  */

    client = cipa
    'GLOBALV SELECT GOPHERD PUT CLIENT'


Parse Var path path '05'x parm
Say argo "Requesting:" path
If parm ^= "" Then Say argo "+ Parms:" parm

Select  /*  type  */

    When path = "" Then Do
        type = '1'
        logmsg = 121    /*  "Root Connection"  */
        End  /*  When  ..  Do  */

    When Left(path,1) = '1' Then Do
        Parse Var path 1 type 2 path
        logmsg = 122    /*  "retrieved directory" path  */
        End  /*  When  ..  Do  */

    When Left(path,1) = '7' Then Do
        Parse Var path 1 type 2 path
        logmsg = 125    /*  "searched directory" path  */
        End  /*  When  ..  Do  */

    When Left(path,1) = '/' Then Do
        type = '0'
        logmsg = 123    /*  "retrieved file" path  */
        End  /*  When  ..  Do  */

    Otherwise Do
        Parse Var path 1 type 2 path
        logmsg = 123    /*  "retrieved file" path  */
        End  /*  Otherwise  Do  */

    End  /*  Select  type  */

'GLOBALV SELECT GOPHERD PUT PATH PARM'
'GLOBALV SELECT GOPHERD SET MENU'

Select  /*  type  */

    When type = "0" Then        /* plain text file */
        pipe = 'APPEND LITERAL .' || ,
            '| E2A | SPEC 1-* 1 x0D0A NEXT'

    When type = "1" Then        /* menu */
        pipe = 'GOPSRVMB | APPEND LITERAL .' || ,
            '| E2A | SPEC 1-* 1 x0D0A NEXT'

    When type = "7" Then        /* menu with search */
        pipe = 'GOPSRVYS' parm '| GOPSRVMB | APPEND LITERAL .' || ,
            '| E2A | SPEC 1-* 1 x0D0A NEXT'

    When type = "9" | ,         /* binary */
         type = "4" | ,         /* Mac file, send as binary */
         type = "5" | ,         /* PC file, send as binary */
         type = "I" | ,         /* send pictures as binary */
         type = "s" Then        /* sound, send as binary */
pipe = 'FBLOCK 8192'    /*  default processing  */

    When type = "p" Then        /* PostScript */
        pipe = 'E2A | SPEC 1-* 1 x0D0A NEXT'

    When type = "r" | ,         /* record oriented file */
         type = "v" Then        /* var-length records */
        pipe = 'BLOCK 65531 CMS |' pipe

    Otherwise                   /* send it as binary */
pipe = 'FBLOCK 8192'    /*  default processing  */

    End  /*  Select  type  */

    'PIPE GOPSRVLS' root '| GOPSRVRP' path ,
            '|' pipe '| FBLOCK 8192 | STEM STEM.'

/*  If rc ^= 0 Then logrqest = logrqest "(rc=" || rc || ")"  */

'PIPE COMMAND XMITMSG' logmsg 'DAY MON DD TIME YY CLIENT PATH' ,
        '(APPLID GOP CALLER SRV ERRMSG |' logpipe


    Say argo stem.0 "blocks to send"
    /*
     *   Send the response to our client
     */
    Do i = 1 to stem.0
        bytes_out = Socket('Write', ns, stem.i)
        If bytes_out = "-1" Then Do
            Say argo tcperror()
            Leave
            End  /*  If  ..  Do  */
        End  /*  Do  For  */


    /*
     *   All done, relinquish our socket descriptor
     */
    rc = Socket('Close', ns)
    If rc = "-1" Then Do
        Say argo tcperror()
        Leave
        End  /*  If  ..  Do  */
    Say argo "Closed" ns "at" Time()


    End  /*  Do  Forever  */


/*
 *   Tell RXSOCKET that we are done with this IUCV path
 */
rc = Socket('Terminate')
If rc = "-1" Then Do
    Say argo tcperror()
    End  /*  If  ..  Do  */


Exit

:READ  GOPSRVLS REXX     A1 TMP200 01/20/93 18:44:35
/*
 *        Name: GOPSRVLS REXX
 *              list a file or directory, feeding to the next stage
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-15, 19
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Parse Source . . arg0 .
Parse Upper Arg fn ft fm . '(' . ')' .
If fn = "" Then fn = '*'
If ft = "" Then ft = '*'
If ft = "FILELIST" & Index(fn,'*') = 0 Then ft = "*"
If fm = "" Then fm = '*'

Parse Arg string
Say arg0 || ':' string

Address "COMMAND" 'GLOBALV SELECT GOPHERD GET MENU NICK CLIENT'

If menu ^= "" Then Do


    Address "CMS" 'STATE' menu 'NAMES *'
    If rc = 0 Then Do

        If nick = "" Then nick = "*"

        'CALLPIPE COMMAND NAMEFIND :NICK' nick ':AUTH :PIPE' ,
                '(FILE' menu '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 32 Then
        'CALLPIPE COMMAND NAMEFIND :FN' fn ':FT' ft ':AUTH :PIPE' ,
                '(FILE' menu '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 32 Then
        'CALLPIPE COMMAND NAMEFIND :NICK * :AUTH :PIPE' ,
                '(FILE' menu '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 0 Then Do

            /*  if auth non-blank  */
            If ^gopsrvau(client,auth) Then Do
                /*  "access restricted"  */
                'CALLPIPE COMMAND XMITMSG 2380' ,
                    '(CALLER GOP ERRMSG' ,
                        '| SPEC /- / 1 1-* NEXT | *:'
                Exit rc
                End  /*  If  ..  Do  */

            If pipe ^= "" Then Do
                'CALLPIPE' pipe '| *:'
                Exit rc
                End  /*  If  ..  Do  */

            End  /*  If  ..  Do  */

        End  /*  If  ..  Do  */

    End  /*  If  ..  Do  */

If ft = '*' Then Do

    Address "CMS" 'STATE' fn 'NAMES *'
    If rc = 0 Then Do

        'CALLPIPE COMMAND NAMEFIND :NICK . :AUTH :PIPE' ,
                '(FILE' fn '| VAR AUTH | DROP' ,
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,
                '| VAR PIPE'

        If rc = 0 Then Do

            /*  if auth non-blank  */
            If ^gopsrvau(client,auth) Then Do
                /*  "access restricted"  */
                'CALLPIPE COMMAND XMITMSG 2380' ,
                    '(CALLER GOP ERRMSG' ,
                        '| SPEC /- / 1 1-* NEXT | *:'
                Exit rc
                End  /*  If  ..  Do  */

            If pipe ^= "" Then Do
                menu = fn
                Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT MENU'
                'CALLPIPE' pipe '| *:'
                Exit rc
                End  /*  If  ..  Do  */

            End  /*  If  ..  Do  */

        End  /*  If  ..  Do  */

    End  /*  If  ..  Do  */

If Index(fn ft, '*') = 0 Then Do
    Address "CMS" 'STATE' fn ft fm
    If rc = 0 Then Do
        'CALLPIPE <' fn ft fm '| *:'
        Exit rc
        End
    Exit rc
    End

If Index(fn,'*') = 0 & ft = '*' Then Do

    Address "COMMAND" 'GLOBALV SELECT GOPHERD SET MENU' fn

    Address "CMS" 'STATE' fn 'FILELIST' fm
    If  rc = 0  Then Do     /*  menu is a FILELIST  */
        'CALLPIPE <' fn 'FILELIST' fm '| *:'
        Exit rc
        End  /*  If  ..  Do  */

    If fm = '*' | fm = "" Then fm = 'A'
    'CALLPIPE COMMAND ACCESS +' || fm || '.' || fn fm
    If rc = 0 Then Do
        /*  menu is an SFS sub-directory  */
        'CALLPIPE' arg0 '* *' fm '| *:'
        lrc = rc
        'CALLPIPE COMMAND ACCESS -' || fm fm
        Exit lrc
        End  /*  If  ..  Do  */
    If rc = 28 | rc = 100 Then Exit rc
    End

/*  shortcut for GOPSRVRP on LISTFILE not FILELIST  */
'OUTPUT' " "
If rc ^= 0 Then Exit rc * (rc ^= 12)

/*  list all files in this directory  */
'ADDPIPE COMMAND LISTFILE' fn ft fm '(ALLFILE ALLOC NOHEADER | *.INPUT:'
If rc ^= 0 Then Do
    'CALLPIPE COMMAND LISTFILE' fn ft fm '(NOHEADER | *:'
    Exit rc
    End  /*  If  ..  Do  */

/*  give SFS directories a filetype '*'  */
Do Forever

    'PEEKTO RECORD'
    If rc ^= 0 Then Leave

    Parse Var record fn ft fm .
    If fm = "DIR" Then 'OUTPUT' "     " fn '*' ft
                  Else 'OUTPUT' "     " fn ft fm

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  If  ..  Do  Forever  */

Exit rc * (rc ^= 12)

:READ  GOPSRVRP REXX     A1 TMP200 01/22/93 18:06:38
/*
 *        Name: GOPSRVRP REXX
 *              resolve gopher paths (selector strings) recursively
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-15, 19
 *
 *              This file is part of CMS Gopher.
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Parse Source . . arg0 .
Parse Arg nick '/' rest
nick = Strip(nick)
rest = Strip(rest)

Do While nick = ""      /*  deal with null parts w/o recursion  */
    If rest = "" Then Do; 'SHORT'; Exit rc; End
    Parse Var rest nick '/' rest
    End  /*  Do  While  */
/*
If nick = "" Then Do    **  deal with null parts by recursion  **
    If rest = "" Then 'SHORT'
                 Else 'CALLPIPE *: |' arg0 rest '| *:'
    Exit rc
    End  **  If  ..  Do  **
 */

/*  look for the shortcut on pure LISTFILE ouptut  */
'PEEKTO RECORD'
If rc ^= 0 Then Exit rc * (rc ^= 12)
If Strip(record) = "" Then Signal SHORTCUT

/*  part = nick;  Upper part  */
Parse Upper Var nick part

Do Forever

    'READTO RECORD'
    If rc ^= 0 Then Leave
    If Left(record,1) = '*' Then Iterate
    If Left(record,1) ^= ' ' Then Leave         /*  short cut  */

    Parse Upper Var record fn ft fm fp '"' . "'" . '05'x .
    If Strip(fn) = "" Then Iterate

    If  fp = "" Then  Select  /*  ft  */
        When  Index(fn,'*') > 0 Then    fp = fn || '.' || ft
        When  ft = ""   | ft = "*"  | ,
              ft = "FILELIST"   Then    fp = fn
        Otherwise                       fp = fn || '.' || ft
        End  /*  Select  ft  */
    If Strip(fp) ^= part Then Iterate

Say "GOPSRVRP: matched" fn ft fm fp
    /*  found it!  */
    /*  Parse Arg nick '/' .  */
    Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT NICK'
    If rest = "" Then 'CALLPIPE GOPSRVLS' fn ft fm '| *:'
                 Else 'CALLPIPE GOPSRVLS' fn ft fm '|' arg0 rest '| *:'
    /*  Leave  */  Exit rc

    End

FALLOUT:
Say "GOPSRVRP: didn't find a match for" nick
/*  fallout;  we didn't find a match in this menu  */
/*  Parse Arg nick  */
nick = nick || '/' || rest
Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT NICK'
'CALLPIPE GOPSRVLS ? ? ? | *:'

Exit rc

SHORTCUT:
Parse Var
Say "GOPSRVRP: shortcut to" fn ft fm fp
    /*  found it!  */
    /*  Parse Arg nick '/' .  */
    Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT NICK'
    If rest = "" Then 'CALLPIPE GOPSRVLS' fn ft fm '| *:'
                 Else 'CALLPIPE GOPSRVLS' fn ft fm '|' arg0 rest '| *:'
    /*  Leave  */  Exit rc


:READ  GOPSRVMB REXX     A1 TMP200 01/25/93 13:44:26
/*
 *        Name: GOPSRVMB REXX
 *              CMS Gopher Server menu builder pipeline stage
 *              Based on the older GOPHERDM REXX stage from 2.3.
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-15
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

uc = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
lc = "abcdefghijklmnopqrstuvwxyz"

/*  sync with input  */
'PEEKTO'
If rc ^= 0 Then Exit rc * (rc ^= 12)

/*  experience shows that sometimes GLOBALV SELECT        *
 *  doesn't work unless you explicitly sync with PEEKTO   */
Address "COMMAND" 'GLOBALV SELECT GOPHERD GET HOST PORT PATH MENU'
localhost = host
localport = port
localpath = path
Say "Global PATH =" path

Do Forever

    'PEEKTO RECORD'
    If rc ^= 0 Then Leave

    key = Left(record,1)
    Select  /*  key  */
        When key = "*" Then nop
        When Strip(record) = "" Then nop
        When key = " " Then Call FILELIST
        Otherwise           Call PREFAB
        End  /*  Select  key  */
    If rc ^= 0 Then Leave

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  For  */

Exit rc * (rc ^= 12)



/* ------------------------------------------------------------ FILELIST
 *  We're apparently reading a plain FILELIST or LISTFILE output.
 */
FILELIST:

q1 = Index(record,"'")
q2 = Index(record,'"')
Select
    When  q1 = 0  & q2 = 0  Then
        Parse Var record fn ft fm fp '05'x name '05'x type '05'x .
    When  q1 = 0  Then
        Parse Var record fn ft fm fp '"'name'"' type .
    When  q2 = 0  Then
        Parse Var record fn ft fm fp "'"name"'" type .
    When  q1 > q2 Then
        Parse Var record fn ft fm fp '"'name'"' type .
    When  q2 > 0  Then
        Parse Var record fn ft fm fp "'"name"'" type .
    End  /*  Select  */

If ft = "" Then ft = "*"
If fm = "" Then fm = "*"
If ft = "GOPHER" | ft = "GOPLINK" Then Do
    /*  read gopher link information  */
    'CALLPIPE <' fn ft fm '| GOPSRVGL | *:'
    Return
    End

/*  this is for Yossie:  hide filemode zero  */
If Length(fm) > 1 Then If Substr(fm,2,1) = '0' Then Return

fp = Strip(fp)
If fp = "" Then Do
    If  Index(fn ft, '*') > 0   | ,
        ft = "FILELIST"         Then fp = Translate(fn,lc,uc)
    Else  fp = Translate(fn||'.'||ft,lc,uc)
    End  /*  If  ..  Do  */

If name = "" Then name = fp     /*  default name is relative path  */
fp = Translate(fp,"%","/")        /*  no slashes in partial path!  */
If type = "" Then type = gtype(ft)
host = localhost
port = localport
path = type || localpath || '/' || fp

/* read overrides from the NAMES file, if any */
If menu ^= "" Then Call GOVER

'OUTPUT' type || name || '05'x || ,
      /* type */ path || '05'x || ,
                 host || '05'x || port

Return



/* -------------------------------------------------------------- PREFAB
 *  Preceeding stage has supplied some of the parameters.  (thank you)
 */
PREFAB:

Parse Var record name '05'x path '05'x host '05'x port '05'x rest
Parse Var path 1 type 2 path
path = type || localpath || '/' || path
If host = "" Then host = localhost
If port = "" Then port = localport
'OUTPUT' name || '05'x || path || '05'x || ,
         host || '05'x || port || '05'x || rest
Return



/* --------------------------------------------------------------- GOVER
 *  Read the specified NAMES file for menu data overrides, if any.
 */
GOVER:

Address "COMMAND" 'STATE' menu 'NAMES *'
If rc ^= 0 Then Return

'CALLPIPE COMMAND NAMEFIND :NICK' fp ,
        ':TYPE :NAME :PATH :HOST :PORT (FILE' menu ,
        '| VAR _TYPE | DROP | VAR _NAME | DROP | VAR _PATH | DROP' ,
        '| VAR _HOST | DROP | VAR _PORT'
If rc ^= 0 Then
'CALLPIPE COMMAND NAMEFIND :FN' fn ':FT' ft ,
        ':TYPE :NAME :PATH :HOST :PORT (FILE' menu ,
        '| VAR _TYPE | DROP | VAR _NAME | DROP | VAR _PATH | DROP' ,
        '| VAR _HOST | DROP | VAR _PORT'
If rc ^= 0 Then Return

/*      defaults for  type, name, path, host, port    *
 *      are supplied by the calling routine           */

If _host ^= "" Then host = _host
If _port ^= "" Then port = _port
If _path ^= "" Then path = _path
If _name ^= "" Then name = _name
If _type ^= "" Then type = _type

Select
    When _host ^= "" & _port = "" Then port = 70
    When _host = "" & _port ^= "" Then host = localhost
    Otherwise nop
    End  /*  When  Select  */

If _host ^= "" | _port ^= "" Then Do
    path = _path
    type = _type
    If type = "" Then type = "1"
    End  /*  If  ..  Do  */
Else If _type ^= "" & _path = "" Then
    path = _type || localpath || '/' || fp

Return



/* --------------------------------------------------------------- GTYPE
 * Returns the default Gopher type character for CMS filetype specified.
 */
GTYPE:    Procedure
Parse Arg ft
Select  /*  ft  */
    When ft = "*"        Then Return '1'
    When ft = "-"        Then Return '1'
    When ft = ""         Then Return '1'
    When ft = "FILELIST" Then Return '1'
    When ft = "GOPHER"   Then Return '1'
/*  When ft = "CSO"      Then Return '2'  */
/*  When ft = ?          Then Return '3'  */
/*  When ft = "MAC"      Then Return '4'  */
/*  When ft = "DOS"      Then Return '5'  */
    When ft = "UUE"      Then Return '6'
/*  When ft = "SEARCH"   Then Return '7'  */
/*  When ft = "TELNET"   Then Return '8'  */
    When ft = "TXT"      Then Return '0'    /*  plain text  */
    When ft = "TEXT"     Then Return '9'    /*  deck; not plain text  */
    When ft = "TXTLIB"   Then Return '9'
    When Left(ft,3) = "TXT" Then Return '9'
    When ft = "CARDDUMP" Then Return '9'
    When ft = "TAR"      Then Return '9'
    When ft = "EXE"      Then Return '9'
    When ft = "DVI"      Then Return '9'
    When ft = "TFM"      Then Return '9'
    When ft = "FMT"      Then Return '9'
    When ft = "ADMGDF"   Then Return '9'
    When ft = "ADMSYMBL" Then Return '9'
    When ft = "SASUSER"  Then Return '9'
    When ft = "SAS6USER" Then Return '9'
    When ft = "SND"      Then Return 's'
/*  When ft = "EPS"      Then Return 'p'  */
/*  When ft = "PS"       Then Return 'p'  */
    When ft = "MODULE"   Then Return 'v'
    When ft = "LOADLIB"  Then Return 'v'
    When ft = "XRX"      Then Return 'v'
    When ft = "GIF"      Then Return 'I'
    Otherwise                 Return '0'
    End  /*  Select  ft  */

:READ  GOPSRVGL REXX     A1 TMP200 01/25/93 14:03:03
/*
 *        Name: GOPSRVGL REXX
 *              read and process a GOPHER (link) file for GOPHERD
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-15
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

Address "COMMAND" 'GLOBALV SELECT GOPHERD GET HOST PORT'
localhost = host;   localport = port
host = "";  port = "";  path = "";  name = "";  type = ""

Do Forever

    'PEEKTO RECORD'
    If rc ^= 0 Then Leave

    If Left(record,1) = '*' Then Call WRITELINK
    If Left(record,1) = '#' Then Call WRITELINK
    If rc ^= 0 Then Leave

    Parse Var record var '=' val
    Upper var; var = Strip(var)
    Select  /*  var  */
        When var = "TYPE" Then type = Strip(val)
        When var = "NAME" Then name = val
        When var = "PATH" Then path = val
        When var = "HOST" Then host = Strip(val)
        When var = "PORT" Then port = Strip(val)
        Otherwise nop   /*  ignore invalid lines  */
        End  /*  Select  var  */

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  Forever  */

If rc = 12 Then Call WRITELINK

Exit rc * (rc ^= 12)



/* ----------------------------------------------------------- WRITELINK
 *  Looks like a break.  Iff we have everthing,
 *  then write this link and reset the variables to empty strings.
 */
WRITELINK:
If  name = "" | type = "" Then  Return
If  host = ""   Then host = localhost
If  host = "+"  Then host = localhost
If  type = "FILE"       Then type = '0'
If  type = "DIRECTORY"  Then type = '1'
If  port = "" Then
Select  /*  type  */
    When  type = '2'  Then port = '105'
    When  type = '8'  Then port = '23'
    When  type = 'T'  Then port = '23'
    Otherwise port = '70'
    End  /*  Select  type  */
'OUTPUT' type || name || '05'x || path || '05'x ,
              || host || '05'x || port
host = "";  port = "";  path = "";  name = "";  type = ""
Return

:READ  GOPSRVAU EXEC     A1 TMP200 01/18/93 15:56:03
/*
 *        Name: GOPSRVAU EXEC, authorization function
 *              returns TRUE (1) if the file/menu may be retrieved
 *              returns FALSE (0) otherwise
 *        Date: 1993-Jan-18
 *      Author: Rick Troth, Rice University, Information Systems
 *
 *              This file is part of CMS Gopher.
 */

/*
 *      Copyright 1993 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended
 *      to serve Rice's user community.   Rice has benefitted greatly
 *      from the free distribution of software,  therefore distribution
 *      of unmodified copies of this material is not restricted.
 *      You may change your own copy as needed.   Neither Rice
 *      University nor any of its employees or students shall be held
 *      liable for damages resulting from the use of this software.
 */

/* ---------------------------------------------------------- AUTHORIZED
 * Verify that the client is allowed access, based on IP addr or name.
 * (we originally used an internal routine called IPA2C(),  but Arty's
 * RXSOCKET provides an Inet_addr() function,  which is now preferred)
 */
AUTHORIZED:
Parse Upper Arg Client,AuthList
If AuthList = "" Then Return 1
ClientAddr = Inet_addr(Client)

rc = Socket('GetHostByAddr', ClientAddr, 'ClientName')
If rc = "-1" Then ClientName = Client
Say "Client looks like" ClientName Inet_ntoa(ClientAddr)
Upper ClientName

allow = 1
Do While AuthList ^= ""

    Parse Var AuthList Auth AuthList
    If Auth = "DENY" Then Do
        allow = 0; Parse Var AuthList Auth AuthList
        End  /*  If  ..  Do  */
    If Auth = "ALLOW" Then Do
        allow = 1; Parse Var AuthList Auth AuthList
        End  /*  If  ..  Do  */
    Say "Auth" Auth
    If Auth = '*' Then Return allow

    Parse Var Auth Auth "," AuthMask "," .
    AuthAddr = Inet_addr(Auth)
    If AuthAddr = "-1" Then Do              /* process as a name spec */
        If Left(Auth,1) = '.' Then Do
            TruncName = Right(ClientName,Length(Auth))
            Say "Truncated ClientName" TruncName
            If TruncName = Auth Then Return allow
            End  /*  If  ..  Do  */
        Else If ClientName = Auth Then Return allow
        End  /*  If  ..  Do  */

    Else Do                                 /* must be a numeric spec */
        AuthMask = Inet_addr(AuthMask)
        If AuthMask = "-1" Then Do
            AuthMask = bitand(AuthAddr,'C0000000'x)
            Select  /*  AuthMask  */
                When AuthMask = '00000000'x Then AuthMask = 'FF000000'x
                When AuthMask = '80000000'x Then AuthMask = 'FFFF0000'x
                When AuthMask = 'C0000000'x Then AuthMask = 'FFFFFF00'x
                End  /*  Select  AuthMask  */
            End  /*  If  ..  Do  */
        Say "ADDR" c2x(AuthAddr) "MASK" c2x(AuthMask)
        AuthAddr = bitxor(AuthAddr,ClientAddr)
        AuthAddr = bitand(AuthAddr,AuthMask)
        If AuthAddr = '00000000'x Then Return allow
        End  /*  Else  Do  */

    End  /*  Do  While  */

Return 0

:READ  GOPSRVYS REXX     A1 TMP200 01/22/93 15:41:34
/*
 *        Name: GOPSRVYS REXX
 *              Gopher Server Search Engine utilizing WISHLP
 *              Original by Yossie Silverman <YOSSIE@UCSFVM>
 *
 *   To create a search item do the following:
 *
 *     1) Create a standard gopher FILELIST of all files to be
 *        searched.  (Only ' fn ft fm title' will work, fm can
 *        (and should) be *
 *     2) GOPGEN INDEX menu
 *     3) Put the name and title of the searched menu
 *        in the menu you want to access it from (parent)
 *     4) Mark the searched menu as Type 7 either
 *        with a NAMES file or in the parent menu.
 */

Parse Arg search                            /* retrieve search string */

'PEEKTO'            /*  sync with input  */

Address "COMMAND" 'GLOBALV SELECT GOPHERD GET MENU FM'
'CALLPIPE COMMAND LISTFILE' menu 'GOPINDEX * (NOHEADER' ,
        '| VAR FILESPEC'
If rc ^= 0 Then Exit rc
Parse Var filespec . . fm .
Say "GOPSRVYS: MENU =" menu '-' fm
'CALLPIPE COMMAND WISHLP' menu 'GOPINDEX' fm search ,
        '| SPEC /      / 1 1-* NEXT | *:'

Exit rc

:READ  GOPHERD  DIRECT   A1 TMP200 01/20/93 18:23:09
USER     GOPHERD  pppppppp 12M  12M  G                                  GOP00010
 INCLUDE  CMS                                                           GOP00020
*:name.GopherD service virtual machine :list.TCPMAINT                   GOP00030
 ACCOUNT  aaaaaaaa dddd                                                 GOP00040
 ACIGROUP gggggggg                                                      GOP00050
 LINK     TCPMAINT  591      191     RR                                 GOP00060
 LINK     TCPMAINT  592      192     RR                                 GOP00070
* at Rice, GOPHERD owns the product disk:                               GOP00080
 MDISK     240 3380 ssss    2 vvvvvv   RR   ALL                         GOP00090
*                                                                       GOP00100
* YES, you can have multiple GopherD service virtual machines.          GOP00110
* See page 127 of the VM TCP/IP v2r2 Planning and Customization guide   GOP00120
* for an example,  "Configuring the FTP Server / Multiple FTP Servers". GOP00130
*                                                                       GOP00140
:READ  EXPAND   REXX     A1 TMP200 12/07/92 12:11:36
/*
 *        Name: EXPAND REXX
 *              Expand Tab Characters function as a pipeline filter
 *              This gem can be replaced with  UNTAB 8,  if available.
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Apr-17, Dec-06
 */

/*  'CALLPIPE *: | UNTAB 8 | *:'  */

Do Forever

    'PEEKTO LINE'
    If rc ^= 0 Then Leave

    tabpos = Pos('05'x,line)
    Do While tabpos > 0
        line = Substr(line,1,tabpos-1) || ,
               Copies('40'x,((tabpos+7)%8)*8-tabpos+1) || ,
               Substr(line,tabpos+1)
        tabpos = Pos('05'x,line)
        End  /*  Do  While  */

    'OUTPUT' line
    If rc ^= 0 Then Leave

    'READTO'

    End  /*  Do  While  */

Exit rc * (rc ^= 12)

:READ  PRINT    REXX     A1 TMP200 01/13/93 12:44:38
/*
 *        Name: PRINT REXX
 *              a disposable filter for printing from
 *              Pipelines-based applications such as CMS Gopher.
 *              (disposable in that you can replace it with your own)
 *      Author: Rick Troth, Rice University, Information Systems
 *              Thanks to Jim Colten for two better versions of
 *              "STANDARD".
 *        Date: Spring 1992, 1993-Jan-07
 *
 *        Note: Address() returns garbage in a pipelines stage
 */

dev = "00E"
linecount = 55
upcase = 0

Parse       Arg name '(' opts ')' .
Parse Upper Var name fn ft fm .
fn = Left(fn,8); ft = Left(ft,8)

fml = Length(fm)
Select  /*  fml  */
    When fml = 1 Then If Datatype(Left(fm1,1),'N') Then fm = ""
    When fml = 2 Then Do
        If Datatype(Left(fm,1),'N') Then fm = ""
        If ^Datatype(Right(fm,1),'N') Then fm = ""
        End  /*  When  ..  Do  */
    Otherwise fm = ""
    End  /*  Select  fm  */

If Words(name) = 2 | Words(name) = 3 Then
    name = Left(fn,8) Left(ft,8) Left(fm,2)

'CALLPIPE COMMAND QUERY CMSLEVEL | CHOP , | VAR CMSLEVEL'
'CALLPIPE CP      QUERY CPLEVEL  | CHOP , | VAR CPLEVEL'
title = "File:" Left(fn,8) Left(ft,8) Left(fm,2) cmslevel '/' cplevel

cc = (ft = "LISTING"  | ft = "LIST3800" | ,
      ft = "LISTCPDS" | ft = "LIST3820" | ft = "LIST38PP")

Do While opts ^= ""
    Parse Var opts op opts; Upper op
    Select  /*  op  */
        When Abbrev("LINECOUNT",op,2) Then Do
            Parse Var opts linecount opts
            If linecount = "" Then linecount = 55
            End  /*  When  ..  Do  */
        When Abbrev("UPCASE",op,2)  Then upcase = 1
        When Abbrev("CC",op,2)      Then cc = 1
        When Abbrev("NOCC",op,4)    Then cc = 0
        When Abbrev("TITLE",op,1)   Then Do
            title = opts
            opts = ""
            End  /*  When  ..  Do  */
        Otherwise Say "Unrecognized option" op
        End  /*  Select  op  */
    End  /*  Do  While  */

If cc Then 'CALLPIPE *: | ASATOMC | URO' dev
/*    Else Call STANDARD      */
Else Do Forever
    'PEEKTO'
    If rc ^= 0 Then Leave
    'CALLPIPE *: | TAKE' linecount ,
        '| SPEC .09. X2C 1  1-* NEXT' ,
        '| PREFACE LITERAL' '19'x || title ,
        '| PREFACE LITERAL' '89'x ,
        '| URO' dev
    If rc ^= 0 Then Leave
    End  /*  Else  ..  Do  Forever  */
prc = rc * (rc ^= 12)

/*  use  CP CLOSE,  so the user can  SPOOL dev CONT  if he wants to  */
If fn = "" Then Parse Value Diag(08,'CLOSE' dev) With rs
           Else Parse Value Diag(08,'CLOSE' dev 'NAME' fn ft) With rs

If rs ^= "" Then
    'CALLPIPE VAR RS | SPLIT AT STRING "' || '15'x || '" | *:'

Return prc



/* ------------------------------------------------------------ STANDARD
 *  Here is a version of STANDARD that loops once per page rather than
 *  once per record.  It should work with most versions of Pipelines.
 */
STANDARD:
header = '19'x || title
'PEEKTO'
Do While rc = 0
    'CALLPIPE *: | TAKE' linecount ,
        '| SPEC .09. X2C 1  1-* NEXT' ,
        '| PREFACE VAR HEADER' ,
        '| PREFACE LITERAL' '89'x ,
        '| URO' dev
    'PEEKTO'
    End  /*  Do  Forever*/
Return



/* ------------------------------------------------------------ PRINTASA
 */
PRINTASA:

'ADDPIPE *.OUTPUT: | URO' dev

'PEEKTO LINE'
Do While rc = 0
    Parse Var line 1 byte 2 line
    line = byte || line
    'OUTPUT' line
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

Return



/*

OVersize
    allows you to print:

    *  files that have records larger than the carriage size of the
       virtual printer, and

    *  files that have a SPECIAL status of YES.

    When the OVERSIZE option is used, the CC option will be set as
    a default.  This default setting of CC can be overridden by
    specifying either the NOCC or the HEX option with the OVersize
    option.

     If the file has a SPECIAL status of YES (and NOCC is not specified),
     any records with a carriage control character of x'5A' will be
     printed if all of the following conditions are true:
        - the record length is not greater than 32767 bytes.
        - a printer subsystem that handles the x'5A' carriage controller
          (such as the 3820 or 3800-3/8) is utilized.
        - a software package that handles such characters (such as PSF)
          is utilized.
     Otherwise, these records will not be printed.

     Other records that are larger than the virtual printer's carriage
     size are printed, but are truncated to the carriage size (or
     carriage size + 1 if CC is specified).

     (The SPECIAL status indicates whether or not the file contains records
     with X'5A' carriage control characters.  See the CP QUERY command to
     determine SPECIAL status of a file.)

    The OVERSIZE (and CC) option is assumed if the filetype is
    LISTCPDS, LIST3820, or LIST38PP.  If OVERSIZE is not specified and
    the file you want to print is larger than the virtual printer's
    carriage size, the message "Records exceeds allowable maximum"
    is displayed.

CC (HEADer)
    interprets the first character of each record as a carriage
    control character.  If the filetype is LISTING, LIST3800, or
    LISTCPDS, the CC option is assumed.  If CC is in effect, the PRINT
    command neither performs page ejects nor counts the number of
    lines per page; these functions are controlled by the carriage
    control characters in the file.  The LINECOUN option has no effect
    if CC is in effect.

    HEADER creates a shortened header page with only the filename,
    filetype, and filemode at the top of the page that follows the
    standard header page.  The records in the file being printed begin
    on a new page following both header pages.  The HEADER option can
    only be used in conjunction with the CC option.  If the CC option
    is not specified HEADER has no effect.

TRC
    interprets the first data byte in each record as a TRC (Table Ref-
    erence Character) byte.  The value of the TRC byte determines
    which translate table the 3800 printer selects to print a record.
    The value of the TRC byte corresponds to the order in which you
    have loaded WCGMs (via the CHARS keyword of the SETPRT command).
    Valid values for TRC are 0, 1, 2, and 3.  If an invalid value is
    found, a TRC byte of 0 is assumed.  If the filetype is LIST3800,
    TRC is assumed.

NOTRC
    does not interpret the first data byte in each record as a TRC
    byte.  NOTRC is the default.

MEMber    <*         >
          <membername>
    prints the members of macro or text libraries. This option may be
    specified if the file is a simulated partitioned data set
    (filetype MACLIB, TXTLIB, or LOADLIB).  If an asterisk (*) is
    entered, all individual members of that library are printed. If a
    membername is specified, only that member is printed.

HEX
    prints the file in graphic hexadecimal format.  If HEX is speci-
    fied, the options CC and UPCASE are ignored, even if specified,
    and even if the filetype is LISTING, LIST3800, LISTCPDS, LIST3820,
    or LIST38PP.  If both the OVersize and HEX options are specified,
    the NOCC option will be in effect.

 */



/* -- Here is a version of STANDARD that does not loop, requires
      pipes mod level 6 (for sync) */
STANDARD2:
header = '19'x || title

  'CALLPIPE (end \)',
    '| literal' '89'x,                /* page eject record?          */
    '| append var header',            /* page header record          */
    '| spec 1-* 1',                   /* simulate BLOCK LINEND by    */
    '       .15. x2c next',           /*   adding linend chars & join*/
    '| join *',                       /*     both recs into 1 rec    */
    '| dup *',                        /* make an endless supply      */
    ,
    '| a: sync',                      /* 2 streams marching together */
    '| b: faninany',                  /* combine the streams         */
    ,
    '| deblock linend',               /* deblock into separate recs  */
    '| uro' dev,                      /* print it                    */
    ,
    '\ *:',                           /* incoming records            */
    '| spec .09. x2c 1',              /* add charriage control and   */
    '       1-* next',                /*  simulate BLOCK LINEND by   */
    '       .15. x2c next',           /*    adding linend chars &    */
    '| join' linecount-1,     /* join all recs for a page into 1 rec */
    '| a:',                           /* send through sync           */
    '| b:'        /* sync sends them back, now send them to faninany */

Return

:READ  A2E      REXX     A1 TMP200 09/24/92 08:16:13
/* ----------------------------------------------------------------- ╞CS
 * ASCII to EBCDIC and vice-versa code conversion tables.
 * Tables included here are based on ASCII conforming to the ISO8859-1
 * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37
 * Latin 1 character set (except for three pairs of characters in 037).
 *
 *        Name: A2E REXX
 *              CMS Pipelines filter to translate ASCII to EBCDIC
 *      Author: Rick Troth, Rice University, I/S VM Systems Support
 *        Date: 1992-Feb-27 for the filter, earlier for the table
 *
 *        Note:
 *              These tables are provided in source form so that you
 *              may modify them locally.  I recommend that you not
 *              modify them just to make things look right on your
 *              screen.  If you have an older terminal and there are
 *              not more than a dozen code-points that are wrong,
 *              then you're better off using CODEPAGE EXEC to set the
 *              CMS INPUT/OUTPUT translate tables.   GOPHER EXEC
 *              *does respect*  CMS' translate tables.
 */

    i =      '000102030405060708090A0B0C0D0E0F'x
    i = i || '101112131415161718191A1B1C1D1E1F'x
    i = i || '202122232425262728292A2B2C2D2E2F'x
    i = i || '303132333435363738393A3B3C3D3E3F'x
    i = i || '404142434445464748494A4B4C4D4E4F'x
    i = i || '505152535455565758595A5B5C5D5E5F'x
    i = i || '606162636465666768696A6B6C6D6E6F'x
    i = i || '707172737475767778797A7B7C7D7E7F'x
    i = i || '808182838485868788898A8B8C8D8E8F'x
    i = i || '909192939495969798999A9B9C9D9E9F'x
    i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x
    i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x
    i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x
    i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x
    i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x
    i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x

    e =      '00010203372D2E2F1605250B0C0D0E0F'x
    e = e || '101112133C3D322618193F271C1D1E1F'x
    e = e || '405A7F7B5B6C507D4D5D5C4E6B604B61'x
    e = e || 'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x
    e = e || '7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x
    e = e || 'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x
    e = e || '79818283848586878889919293949596'x
    e = e || '979899A2A3A4A5A6A7A8A9C04FD0A107'x
    e = e || '202122232415061728292A2B2C090A1B'x
    e = e || '30311A333435360838393A3B04143EFF'x
    e = e || '41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x
    e = e || '908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x
    e = e || '6465626663679E687471727378757677'x
    e = e || 'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x
    e = e || '4445424643479C485451525358555657'x
    e = e || '8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x

/* ----------------------------------------------------------------- A2E
 * Translate ASCII to EBCDIC.
 */
'READTO LINE'
Do While rc = 0
    'OUTPUT' Translate(line,e,i)
    'READTO LINE'
    End  /*  Do  While  */

Exit

:READ  E2A      REXX     A1 TMP200 09/24/92 08:33:08
/* ----------------------------------------------------------------- ╞CS
 * ASCII to EBCDIC and vice-versa code conversion tables.
 * Tables included here are based on ASCII conforming to the ISO8859-1
 * Latin 1 character set and EBCDIC conforming to the IBM Code Page 37
 * Latin 1 character set (except for three pairs of characters in 037).
 *
 *        Name: E2A REXX
 *              CMS Pipelines filter to translate EBCDIC to ASCII
 *      Author: Rick Troth, Rice University, I/S VM Systems Support
 *        Date: 1992-Feb-27 for the filter, earlier for the table
 *
 *        Note:
 *              These tables are provided in source form so that you
 *              may modify them locally.  I recommend that you not
 *              modify them just to make things look right on your
 *              screen.  If you have an older terminal and there are
 *              not more than a dozen code-points that are wrong,
 *              then you're better off using CODEPAGE EXEC to set the
 *              CMS INPUT/OUTPUT translate tables.   GOPHER EXEC
 *              *does respect*  CMS' translate tables.
 */

    i =      '000102030405060708090A0B0C0D0E0F'x
    i = i || '101112131415161718191A1B1C1D1E1F'x
    i = i || '202122232425262728292A2B2C2D2E2F'x
    i = i || '303132333435363738393A3B3C3D3E3F'x
    i = i || '404142434445464748494A4B4C4D4E4F'x
    i = i || '505152535455565758595A5B5C5D5E5F'x
    i = i || '606162636465666768696A6B6C6D6E6F'x
    i = i || '707172737475767778797A7B7C7D7E7F'x
    i = i || '808182838485868788898A8B8C8D8E8F'x
    i = i || '909192939495969798999A9B9C9D9E9F'x
    i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x
    i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x
    i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x
    i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x
    i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x
    i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x

    a =      '000102039C09867F978D8E0B0C0D0E0F'x
    a = a || '101112139D8508871819928F1C1D1E1F'x
    a = a || '80818283840A171B88898A8B8C050607'x
    a = a || '909116939495960498999A9B14159E1A'x
    a = a || '20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x
    a = a || '26E9EAEBE8EDEEEFECDF21242A293B5E'x
    a = a || '2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x
    a = a || 'F8C9CACBC8CDCECFCC603A2340273D22'x
    a = a || 'D8616263646566676869ABBBF0FDFEB1'x
    a = a || 'B06A6B6C6D6E6F707172AABAE6B8C6A4'x
    a = a || 'B57E737475767778797AA1BFD05BDEAE'x
    a = a || 'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x
    a = a || '7B414243444546474849ADF4F6F2F3F5'x
    a = a || '7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x
    a = a || '5CF7535455565758595AB2D4D6D2D3D5'x
    a = a || '30313233343536373839B3DBDCD9DA9F'x

/* ----------------------------------------------------------------- E2A
 * Translate EBCDIC to ASCII.
 */
'READTO LINE'
Do While rc = 0
    'OUTPUT' Translate(line,a,i)
    'READTO LINE'
    End  /*  Do  While  */

Exit

:READ  TCPA2E   REXX     A1 TMP200 01/05/93 17:34:55
/*
 *        Name: TCPA2E REXX
 *              CMS Pipelines filter to translate ASCII to EBCDIC
 *              basing translation on VM TCP/IP supplied tables
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Apr-27, 1993-Jan-05
 */

Parse Upper Arg table . '(' .

If table = "" Then table = "STANDARD"
'CALLPIPE DISK' table 'TCPXLBIN | STEM XLT.'

/*  if specified table is unavailable,  fall back to default  */
If xlt.0 < 3 Then Do
    'CALLPIPE *: | A2E | *:'
    Exit rc
    End  /*  If  ..  Do  */

/*
 * variables:
 *              xlt.0   should be "3",  meaning three records read
 *              xlt.1   should be a comment
 *              xlt.2   should be our ASCII ---> EBCDIC table
 *              xlt.3   should be our EBCDIC ---> ASCII table
 *              i       is set to the dummy input table
 */

    i =      '000102030405060708090A0B0C0D0E0F'x
    i = i || '101112131415161718191A1B1C1D1E1F'x
    i = i || '202122232425262728292A2B2C2D2E2F'x
    i = i || '303132333435363738393A3B3C3D3E3F'x
    i = i || '404142434445464748494A4B4C4D4E4F'x
    i = i || '505152535455565758595A5B5C5D5E5F'x
    i = i || '606162636465666768696A6B6C6D6E6F'x
    i = i || '707172737475767778797A7B7C7D7E7F'x
    i = i || '808182838485868788898A8B8C8D8E8F'x
    i = i || '909192939495969798999A9B9C9D9E9F'x
    i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x
    i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x
    i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x
    i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x
    i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x
    i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x

/* ----------------------------------------------------------------- A2E
 * Translate ASCII to EBCDIC.
 */
'READTO LINE'
Do While rc = 0
    'OUTPUT' Translate(line,xlt.2,i)
    'READTO LINE'
    End  /*  Do  While  */

Exit

:READ  TCPE2A   REXX     A1 TMP200 01/05/93 17:34:56
/*
 *        Name: TCPE2A REXX
 *              CMS Pipelines filter to translate EBCDIC to ASCII
 *              basing translation on VM TCP/IP supplied tables
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Apr-27, 1993-Jan-05
 */

Parse Upper Arg table . '(' .

If table = "" Then table = "STANDARD"
'CALLPIPE DISK' table 'TCPXLBIN | STEM XLT.'

/*  if specified table is unavailable,  fall back to default  */
If xlt.0 < 3 Then Do
    'CALLPIPE *: | E2A | *:'
    Exit rc
    End  /*  If  ..  Do  */

/*
 * variables:
 *              xlt.0   should be "3",  meaning three records read
 *              xlt.1   should be a comment
 *              xlt.2   should be our ASCII ---> EBCDIC table
 *              xlt.3   should be our EBCDIC ---> ASCII table
 *              i       is set to the dummy input table
 */

    i =      '000102030405060708090A0B0C0D0E0F'x
    i = i || '101112131415161718191A1B1C1D1E1F'x
    i = i || '202122232425262728292A2B2C2D2E2F'x
    i = i || '303132333435363738393A3B3C3D3E3F'x
    i = i || '404142434445464748494A4B4C4D4E4F'x
    i = i || '505152535455565758595A5B5C5D5E5F'x
    i = i || '606162636465666768696A6B6C6D6E6F'x
    i = i || '707172737475767778797A7B7C7D7E7F'x
    i = i || '808182838485868788898A8B8C8D8E8F'x
    i = i || '909192939495969798999A9B9C9D9E9F'x
    i = i || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x
    i = i || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x
    i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x
    i = i || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x
    i = i || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x
    i = i || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x

/* ----------------------------------------------------------------- E2A
 * Translate EBCDIC to ASCII.
 */
'READTO LINE'
Do While rc = 0
    'OUTPUT' Translate(line,xlt.3,i)
    'READTO LINE'
    End  /*  Do  While  */

Exit

:READ  STANDARD TCPXLATE A1 TMP200 04/27/92 14:45:29
;  ----------------------------------------------------------------- ╞CS
;  ASCII to EBCDIC and vice-versa code conversion tables for IBM TCP/IP.
;  Tables defined here are based on ASCII conforming to the ISO8859-1
;  Latin 1 character set and EBCDIC conforming to IBM Code Page 1047
;  Latin 1 character set.   See also AECS C  (from Rice University).
;
;  ASCII ---> EBCDIC
;       00 01 02 03  04 05 06 07  08 09 0A 0B  0C 0D 0E 0F
;
        00 01 02 03  37 2D 2E 2F  16 05 25 0B  0C 0D 0E 0F  ; 00 ;
        10 11 12 13  3C 3D 32 26  18 19 3F 27  1C 1D 1E 1F  ; 10 ;
        40 5A 7F 7B  5B 6C 50 7D  4D 5D 5C 4E  6B 60 4B 61  ; 20 ;
        F0 F1 F2 F3  F4 F5 F6 F7  F8 F9 7A 5E  4C 7E 6E 6F  ; 30 ;
        7C C1 C2 C3  C4 C5 C6 C7  C8 C9 D1 D2  D3 D4 D5 D6  ; 40 ;
        D7 D8 D9 E2  E3 E4 E5 E6  E7 E8 E9 AD  E0 BD 5F 6D  ; 50 ;
        79 81 82 83  84 85 86 87  88 89 91 92  93 94 95 96  ; 60 ;
        97 98 99 A2  A3 A4 A5 A6  A7 A8 A9 C0  4F D0 A1 07  ; 70 ;
        20 21 22 23  24 15 06 17  28 29 2A 2B  2C 09 0A 1B  ; 80 ;
        30 31 1A 33  34 35 36 08  38 39 3A 3B  04 14 3E FF  ; 90 ;
        41 AA 4A B1  9F B2 6A B5  BB B4 9A 8A  B0 CA AF BC  ; A0 ;
        90 8F EA FA  BE A0 B6 B3  9D DA 9B 8B  B7 B8 B9 AB  ; B0 ;
        64 65 62 66  63 67 9E 68  74 71 72 73  78 75 76 77  ; C0 ;
        AC 69 ED EE  EB EF EC BF  80 FD FE FB  FC BA AE 59  ; D0 ;
        44 45 42 46  43 47 9C 48  54 51 52 53  58 55 56 57  ; E0 ;
        8C 49 CD CE  CB CF CC E1  70 DD DE DB  DC 8D 8E DF  ; F0 ;
;
;  EBCDIC ---> ASCII
;       00 01 02 03  04 05 06 07  08 09 0A 0B  0C 0D 0E 0F
;
        00 01 02 03  9C 09 86 7F  97 8D 8E 0B  0C 0D 0E 0F  ; 00 ;
        10 11 12 13  9D 85 08 87  18 19 92 8F  1C 1D 1E 1F  ; 10 ;
        80 81 82 83  84 0A 17 1B  88 89 8A 8B  8C 05 06 07  ; 20 ;
        90 91 16 93  94 95 96 04  98 99 9A 9B  14 15 9E 1A  ; 30 ;
        20 A0 E2 E4  E0 E1 E3 E5  E7 F1 A2 2E  3C 28 2B 7C  ; 40 ;
        26 E9 EA EB  E8 ED EE EF  EC DF 21 24  2A 29 3B 5E  ; 50 ;
        2D 2F C2 C4  C0 C1 C3 C5  C7 D1 A6 2C  25 5F 3E 3F  ; 60 ;
        F8 C9 CA CB  C8 CD CE CF  CC 60 3A 23  40 27 3D 22  ; 70 ;
        D8 61 62 63  64 65 66 67  68 69 AB BB  F0 FD FE B1  ; 80 ;
        B0 6A 6B 6C  6D 6E 6F 70  71 72 AA BA  E6 B8 C6 A4  ; 90 ;
        B5 7E 73 74  75 76 77 78  79 7A A1 BF  D0 5B DE AE  ; A0 ;
        AC A3 A5 B7  A9 A7 B6 BC  BD BE DD A8  AF 5D B4 D7  ; B0 ;
        7B 41 42 43  44 45 46 47  48 49 AD F4  F6 F2 F3 F5  ; C0 ;
        7D 4A 4B 4C  4D 4E 4F 50  51 52 B9 FB  FC F9 FA FF  ; D0 ;
        5C F7 53 54  55 56 57 58  59 5A B2 D4  D6 D2 D3 D5  ; E0 ;
        30 31 32 33  34 35 36 37  38 39 B3 DB  DC D9 DA 9F  ; F0 ;
;
:READ  GOPUME   MESSAGES A1 TMP200 01/21/93 15:30:04
*
*         Name: GOPUME MESSAGES
*               CMS Gopher Message Repository source
*               Thanks to Chris Martin for RICUME as an example.
*       Author: Rick Troth, Rice University, Information Systems
*         Date: 1992-Dec-17
*
*         Note:
*               After changing this file,
*               run the following command:
*
*                       GENMSG GOPUME MESSAGES A GOP
*
*               This will create a new GOPUME TEXT which must
*               replace the supplied copy on the product disk.
*
*      Changes: -none-
*
************************************************************************
*
*       The following line specifies the substitution character
*       and number of digits of message number to be shown.
*       DO NOT CHANGE!
*
& 3
*
************************************************************************
*
*xxx    I CMS Gopher 2.4.0 client
*
0000    I Rice CMS Gopher 2.4.0
0001    S You must have RXSOCKET to run CMS Gopher.
0002    S You must have VM TCP/IP V2 to run CMS Gopher.
0003    S You must have CMS Pipelines to run CMS Gopher.
0004    I (root menu)
0005    I More
0006    E No read/write &1 disk/directory accessed.
0007    I &1
0008      Gopher
0009      Client
0010      Server
*
0020    I Connecting ...
0021    I Connecting ... press ENTER twice to abort.
0022    I Connecting to &1 port &2.
0023    I Connection to &1 port &2 refused. (no gopher hole there)
0024    I Reading ...
0025    I Reading ... press ENTER twice to abort.
0026    I Read &1 bytes.
0027    I Request aborted.
0028    I Connection canceled by user request.
0029    I Connection canceled by timeout.
0030    I CMS Gopher TELNET connecting to &1 &2
0031    I CMS Gopher TN3270 connecting to &1 &2
0032    I login with: &1
0033    R Press ENTER to continue ...
0034    R Press CLEAR to continue ...
*
0040    I &1's Bookmarks
0041    I Bookmark &1 saved.
0042    I Bookmark &1 deleted.
0043    E Can't save/delete bookmarks at this terminal.
0044    I Bookmarks for &1
*
0060    E Empty menu; no items selected or nothing available.
*
0100    S Error reading from the terminal.
0117    S Error writing to display terminal.
*
0394    W Invalid option: &1
*
0507    E Can't PRINT from this terminal.
0508    E Can't SAVE/GET files via this terminal.
0509    E Can't save or delete bookmarks at this terminal.
0512    E Can't run &1 on this terminal.
*
0510    I Saved &2 as &1.
0514    E Return code &1 from &2.
0546    E Target not found.
0571    I Created &1 from &2.
0594    E File &1 already exists.
*
*601    R Enter specification list:
0601    R Enter keyword(s):
0602    R Enter search string:;&1
*
* PFkey help lines
0613  01  1= Help       2=           3= Return
0613  01     4= Print      5=          6= Find
0613  02  7= Backward   8= Forward   9= Bookmark
0613  02  10= Booklist  11=         12= Quit
0614  01  1= Help       2=           3= Return
0614  01     4= Print      5=          6= Find
0614  02  7= Backward   8= Forward   9= Bookmark
0614  02  10= Booklist  11= XEDIT   12= Quit
0615  01  1= Help       2=           3= Return
0615  01     4= Print      5=          6= Find
0615  02  7= Backward   8= Forward   9= Delete
0615  02    10= Refresh   11=         12= Quit
*
0657    E Undefined PFkey/PAkey: &1
0696    W Invalid data received from the display.
*
************************************************************************
*
*   The range  652..907  (0..255 plus 700 minus 48)
*   is reserved for local language tags to gopher types.
*   (message numbers 0657 and 0696 violate this rule)
*
*   Not all of these are official.   Not all of these will remain.
*
0652    E type 0x00
0653    E type 0x01
0654    E type 0x02
0655    E type 0x03
*
* types represented by digits 0..9:
0700      <document>
0701      <menu>
0702      <phonebk>
0703      <error>
0704      <MAC>
0705      <DOS>
0706      <UUE>
0707      <search>
0708      <telnet>
0709      <binary>
*
* types represented ASCII after digits:
0710      [Picture]
0711      [Movie]
0712      [Sound]
* (I wish they hadn't done this!)
*
0717    E type "A"
0718    E type "B"
0719    E type "C"
0720    E type "D"
0721    E type "E"
0722    E type "F"
0723    E type "G"
0724    E type "H"
0725      <picture>
0726    E type "J"
0727    E type "K"
0728    E type "L"
0729      <MIME>
0730    E type "N"
0731    E type "O"
0732    E type "P"
0733    E type "Q"
0734    E type "R"
0735    E type "S"
0736      <tn3270>
0737    E type "U"
0738    E type "V"
0739    E type "W"
0740    E type "X"
0741    E type "Y"
0742    E type "Z"
*
0749    E type "a"
0750    E type "b"
0751    E type "c"
0752    E type "d"
0753    E type "e"
0754    E type "f"
0755      <picture>
0756    E type "h"
0757      <info>
0758    E type "j"
0759    E type "k"
0760    E type "l"
0761    E type "m"
0762    E type "n"
0763    E type "o"
0764    E type "p"
0765    E type "q"
0766      <record>
0767      <sound>
0768    E type "t"
0769    E type "u"
0770      <varrec>
0771    E type "w"
0772    E type "x"
0773    E type "y"
0774    E type "z"
*
0904    E type 0xFC
0905    E type 0xFD
0906    E type 0xFE
0907    E type 0xFF
0908    E type &1
*
************************************************************************
*
0925    S I/O error on screen.
0926    S CMS Gopher requires a display terminal.
*
************************************************************************
*
*xxx    I CMS Gopher 2.4.0 server
*
*         wd mm dd tm yy cl :   ...text...   path or user
0120    I &1 &2 &3 &4 &5 &6 : Starting gopher daemon &7
0121    I &1 &2 &3 &4 &5 &6 : Root Connection
0122    I &1 &2 &3 &4 &5 &6 : retrieved directory &7
0123    I &1 &2 &3 &4 &5 &6 : retrieved file &7
0124    I &1 &2 &3 &4 &5 &6 : access restricted.
*
0125    E access restricted.
2380    S You are not authorized to view this data.
*
0126    E Gopher TCP/IP service port must be numeric.
*
************************************************************************
*
* I "borrowed" the following strings from the UNIX curses client.
* Some of these messages may show-up in CMS Gopher at some time.
*
* Press &1 for Help, &2 to Quit, &3 to go up a menu
* Page: &1/&2
* Move To Line:
* Search String:
* Search failed...
* Warning!!!!!, you are about to leave the Internet Gopher program
*         and connect to another host.
* If you get stuck press the control key and the ] key,
*         and then enter quit
* Now connecting to &1
* Use the account name "&1" to log in
* Press return to connect, q to cancel:
* Out of memory
* Index word(s) to search for:
* Sorry, this machine doesn't support sounds
* Couldn't make a tmp file!
* Problems Writing File
* Warning! File may be corrupt!
* File received successfully
* Couldn't unlink!!!
* Save in file:
* Could not open file
* Connecting to server...
* Receiving file...
* Problems Writing
* Warning! File may be corrupt!
* File received successfully
* Cannot connect to host &1:
* Really quit (y/n) ?
* could not unlink &1
* I don't understand your terminal type
* signal died:
* Pager Command
* Print Command
* Telnet Command
* Sound Command
* Mail Command
* 3270 Emulator Command
* MIME pager
* Image Viewer
* Sorry, you are not allowed to set options in secure mode.
* Internet Gopher Options
* Usage: &1 [-sb] [-p path] [-t title] [hostname port]
* Root gopher server: &1
* &1: Nothing received for main menu, can't continue
* Strange Error occurred!
* No bookmarks are defined
* Bookmarks
* Name for this bookmark?
* Sorry, can't make a bookmark of bookmarks
* Sorry, can't delete top level directory.
* Gopher Item Information
* Gopher Directory Information
* Searching Text...
* Connecting...
* Retrieving Directory...
* Searching...
* Nothing available.
* Receiving Information...
* Sorry, cannot transfer files in securemode
* Receiving Directory...
* Searching Text...
* Receiving Sound...
* Receiving HTML page...
* Couldn't make a tmp file!
* Name=%s
* Type=%c
* Port=%d
* Path=%s
* Host=%s
* Couldn't unlink!!!
* Internet Gopher Information Client v1.03
* Press any key to return to gopher:
* Out of memory!
* Mail document to:
* Address syntax rejected...
* Mailing File...
* builtin
* Press <RETURN> to continue
* Saving File...
* Enter save file name:
* Error opening &1:  Enter new name or <Enter> to cancel:
* File cannot be opened!
* Press <RETURN> to exit
* Press 1-&1 to change a field, Return to accept fields
*         and continue
* Press Return when finished
* Press <ESC> to accept fields and continue
* Press <ESC> to accept fields and continue
* or press <CTRL-A> to abort
*         <press RETURN>
* Name
* Phone
* E-Mail
* Address
* name
* phone
* email
* address
* Data for Lines 1, 2, or 3 REQUIRED
* query
* Searching...
* Couldn't make a tmp file!
* Couldn't unlink!!!
* unknown
* -- press space for more --
* -- press space for more, use arrow keys to move,
*         '?' for help, 'q' to quit
* Commands: Use arrow keys to move, '?' for help,
*         'q' to quit
* <Space> for next page
* bookmarks:
* localhost
* Bookmarks
* Pagercmd:
* Printercmd:
* Telnetcmd:
* Mailcmd:
* Playcmd:
* TN3270cmd:
* MIMEcmd:
* Imagecmd:
* Aborting gopher configuration save!!
* Can't write gopher configuration file!!
* Pagercmd:
* Printercmd:
* Telnetcmd:
* Mailcmd:
* Playcmd:
* TN3270cmd:
* MIMEcmd:
* Imagecmd:
* bookmarks:
* Termcap entry too long
* Bad termcap entry
* Infinite tc= loop
* Termcap entry too long
* Not owner
* No such file or directory
* No such process
* Interrupted system call
* I/O error
* No such device or address
* Arg list too long
* Exec format error
* Bad file number
* No children
* No more processes
* Permission denied
* Bad address
* Block device required
* Device busy
* File exists
* Cross-device link
* No such device
* Not a directory
* Is a directory
* Invalid argument
* File table overflow
* Too many open files
* Inappropriate ioctl for device
* Text file busy
* File too large
* No space left on device
* Illegal seek
* Read-only file system
* Too many links
* Broken pipe
* Argument too large
* Result too large
* Operation would block
* Operation now in progress
* Operation already in progress
* Socket operation on non-socket
* Destination address required
* Message too long
* Protocol wrong type for socket
* Option not supported by protocol
* Protocol not supported
* Socket type not supported
* Operation not supported on socket
* Protocol family not supported
* Address family not supported by protocol family
* Address already in use
* Can't assign requested address
* Network is down
* Network is unreachable
* Network dropped connection on reset
* Software caused connection abort
* Connection reset by peer
* No buffer space available
* Socket is already connected
* Socket is not connected
* Can't send after socket shutdown
* Too many references: can't splice
* Connection timed out
* Connection refused
* Too many levels of symbolic links
* File name too long
* Host is down
* Host is unreachable
* Directory not empty
* Too many processes
* Too many users
* Disc quota exceeded
* Stale NFS file handle
* Too many levels of remote in path
* Not a stream device
* Timer expired
* Out of stream resources
* No message of desired type
* Not a data message
* Identifier removed
* Deadlock situation detected/avoided
* No record locks available
* Machine is not on the network
* Object is remote
* Link has been severed
* Advertise error
* Srmount error
* Communication error on send
* Protocol error
* Multihop attempted
* Remote address changed
* Function not implemented
*
************************************************************************
*
9999    I CMS Gopher message repository language: AMENG
* someone want to write  French, German, Italian, etc?
*
:READ  GOPXEDPR XEDIT    A1 TMP200 01/12/93 16:26:39
/*
 *        Name: GOPXEDPR XEDIT (was GOPHER XEDIT)
 *              a PROFILE for XEDIT when used as a Gopher file viewer
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-14
 *
 *              When XEDIT is designated as the file viewer,  GOPHERCV
 *              looks for GOPHER XEDIT.   If it exists,  it is used as
 *              the XEDIT PROFILE;  otherwise,  you get your own.
 *              In this example,  you get your own PROFILE,  with
 *              the command  "MACRO ITEMINFO"  on the program stack.
 */

Parse Arg string
Push "MACRO GOPXEDII"
Push "COMMAND SET SYNONYM ITEMINFO 4 GOPXEDII"
Call PROFILE string
If Symbol(result) = "LIT" Then Result = 0
Exit result

:READ  GOPXEDII XEDIT    A1 TMP200 12/18/92 13:48:36
/*
 *        Name: GOPXEDII XEDIT (was ITEMINFO XEDIT)
 *              display gopher "item info" in the XEDIT message area
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Dec-10
 *
 *              This macro is part of CMS Gopher.
 */

Parse Source . . . . . arg0 .

'COMMAND CMS GLOBALV SELECT GOPHER GET PROGID'
If progid = "" Then Do
    /*  You're not running CMS Gopher  */
    'COMMAND CMS XMITMSG 542 ARG0 (VAR'
    'EMSG' message.1
    Exit
    End

'COMMAND CMS GLOBALV SELECT GOPHER GET ITEM'
Parse Var item . '05'x path '05'x host '05'x port '05'x .
If host ^= "" & port ^= "" & path ^= "" Then
    'COMMAND MSG' host || ':' || port || ':' || path

Exit

:READ  GOPHMARK EXEC     A1 TMP200 11/19/92 15:28:53
/*
 *        Name: GOPHMARK EXEC
 *              Migrate CMS Gopher bookmarks from 2.3 to 2.4
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Nov-17
 */

'GLOBALV SELECT GOPHER GET BOOKMARK.0'
If Datatype(bookmark.0,'N') Then Exit

'PIPE COMMAND GLOBALV SELECT GOPHMARK LIST' ,
        '| DROP | STRIP LEADING | STEM MARK.'

Do i = 1 to mark.0
    Parse Var mark.i . '=' name '05'x host '05'x ,
    port '05'x path '05'x . '05'x type '05'x .
    Select  /*  type  */
        When type = "file" Then type = 0
        When type = "menu" Then type = 1
        Otherwise               type = Left(path,1)
        End
    bookmark.i = type || name || '05'x || path || '05'x || ,
                         host || '05'x || port
    'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
    End

bookmark.0 = mark.0
'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'

:READ  PH       EXEC     A2 TMP200 01/14/93 05:50:02
/* ph exec - query name server for person.                    */
/* Nick Laflamme - U. of Notre Dame                           */
/* [e-mail]                              */
/* UDM/Nick                                                   */
/*                                                            */
/* based heavily on GOPHER EXEC by Rick Troth, Rice U.        */
/* which in turn relies heavily on Arty Ecoky's RXSOCKET      */
/* May, 1992                                                  */
/*      modified: June 4, 1992: add stack option                     */
/*                also pull in improvements from FIXAFSID            */
/*      modified: September 2, 1992: add UNIQUE, STACKALL, HOST, PORT*/
/*                options, changed calling conventions.              */
/* Last modified: December 4, 1992 - January 8, 1993: GLOBALV for    */
/*                host, port, support for FIELDS and                 */
/*                fill-in-the-blanks queries                         */

/* return codes:             */
/*  0: no problem            */
/*  1: no matches            */
/*  2: too many matches      */
/*  3: bad parameters        */
/*  4: no end of data?       */
/*  5: Read or Write failed  */
/*  6: internal error        */
/*  7: user signalled done   */
/*  8: not unique            */
/*100: incorrect use/environ */

signal prologue                         /* skip to start of code      */

/* SYNTAX: and NOVALUE: come first so REXX can always find them       */

syntax:                                 /* in case of syntax error    */
erc = rc                                /* preserve error code        */
$error='REXX error' erc 'in line' sigl':' errortext(erc)
say $error                              /* get excited                */
say "Line" sigl':' sourceline(sigl)     /* show offending line        */
trace '?r'; nop                         /* start trace mode for debug */
rc = Socket('Terminate')
exit erc

novalue:
$error='Novalue error in line' sigl
say $error                              /* get excited                */
say sourceline(sigl)                    /* show offending line        */
trace '?r'; nop                         /* start trace mode for debug */
rc = Socket('Terminate')
exit 100

prologue:                               /* start of real code         */
signal on novalue             /* complain about missing vairables     */
signal on syntax              /* semi-graceful exit for syntax errors */
parse source . invocation progfn progft progfm calledas addressee

parse arg wanthelp .          /* check first argument                 */
select
when wanthelp='?' then
 signal somehelp        /* break to explanation                 */
when wanthelp='??' then
 signal morehelp        /* break to long explanation            */
otherwise
 nop                    /* on with life                         */
end   /* of select on wanthelp      */

/* trace i */

/************* START OF CODE *************************/

Address "COMMAND"

progid = "CMS PH 1.98"           /* 2.00: GLOBALV, FIELDS, user input */

Signal on SYNTAX

'STATE RXSOCKET MODULE *'
If rc ^= 0 Then Do
Say "You must have RXSOCKET to run" progid
Exit rc
End  /*  If  ..  Do  */

'STATE TCPIP DATA *'
If rc ^= 0 Then Do
Say "You must have VM TCP/IP V2 accessed to run" progid
Exit rc
End  /*  If  ..  Do  */

'STATE PIPE MODULE *'
If rc ^= 0 Then Do
Say "You must have CMS Pipelines to run" progid
Exit rc
End  /*  If  ..  Do  */

HHOST = "ns.nd.edu"
HPORT = 105
unique = 0                   /* by default, not looking for just one */
stackall = 0                 /* by default, don't dump all to stack  */
stack = 0                    /* not going for stacked output         */
exitrc = 0                             /* optimistic default         */

/* Parse Arg whom "(" host hport "(" all */
Parse Arg whom "(" optstring "(" whoops
if whoops /= '' then
do
say "Calling conventions have changed."
exit 100
end
optstring = translate(optstring,' ','=') /* allow "=" as whitespace  */
do while optstring /= ''
parse var optstring thisopt optstring
select
when translate(thisopt) = 'HOST' then
parse var optstring hhost optstring
when translate(thisopt) = 'PORT' then
parse var optstring hport optstring
when translate(thisopt) = 'UNIQUE' then
do
stack = 1
unique = 1
end
when translate(thisopt) = 'STACK' then
stack = 1
when translate(thisopt) = 'STACKALL' then
do
stack = 1
stackall = 1
end
otherwise
say "Unknown option:" thisopt
end                                                      /* select */
end                                 /* do while optstring isn't null */

helpstuff = '"Quit" means leave PH.  "Accept" means return this entry.'
helpstuff = helpstuff '"Done" means leave PH and the calling program.'

/* now check global variables in case this is a Gopher-callee */
'GLOBALV SELECT PHCMS GET HOST PORT'
if host = '' then
host = hhost
if port /= '' then
do
hport = port
say hport c2d(hport)
end
if hport /= strip(hport) then
do
say 'Troth was right, I need a strip.'
hport = strip(hport)
end

if index(host,'.') = 0 then
do
if ^stack then
say "Hostname" host "doesn't contain a period.  Is that correct?"
exit 100
end
if datatype(hport,'W') = 0 then
do
if ^stack then
say hport "isn't a valid port number."
exit 100
end

/*
**   Initialize RXSOCKET
*/

maxdesc = Socket('Initialize', 'phCMS')
If maxdesc="-1" Then
do
if ^stack then
say "INITIALIZE" errno
exit 5
end

/* much of the following is copied from the RXSOCKET help files */
s  = Socket('Socket', 'AF_INET', 'Sock_Stream')
family  = AF_INET
port    = Htons(hport)

/*
**   Enable ASCII<->EBCDIC Translation Option
*/
rc = Socket('SetSockOpt', s, 'SOL_SOCKET', 'SO_EBCDIC', 1)
If rc = "-1" Then
Do
if ^stack then
say "RXSOCKET subfunction SetSockOpt returned error" errno
exit 5
End

Netaddr = Socket('GetHostByName', host)
name    = family || port || netaddr
Crc = Socket('Connect', s, name)

abort = 0

if whom = '' then
call get_target
else
data       = "query" whom||'0D25'x

if abort then /* from input screen */
do
rc = socket('Terminate')               /* ending early     */
exit 7
end

bytes_sent = Socket('Write', s, data)
if bytes_sent = -1 then
do
if ^stack then
say "Write failed.  Errno:" errno
rc = Socket('Terminate')
exit 5
end
bytes_read = Socket('Read', s, 'buffer')
if bytes_read = -1 then
do
if ^stack then
say "Read failed.  Errno:" errno
rc = Socket('Terminate')
exit 5
end

"PIPE (end \) var buffer ",
"| deblock linend 25 ",
"| stem rawdata.",
"| c: nfind 501:No matches to your query",
"| d: nfind 502:Too many entries to prin",
"| a: nfind 102",
"| b: nfind 200:Ok",
"| e: nfind 598:",
"| find 500:Did not understand query",
"| f: faninany",
"| count lines",
"| var badquery",
"\ a:",
"| specs word 3 1",
"| var howmany",
"\ b:",
"| count lines",
"| var OK",
"\ c:",
"| count lines",
"| var NotFound",
"\ e:",
"| f:",
"\ d:",
"| count lines",
"| var TooMany"

If NotFound then
do
if ^stack then
say "Nothing found for" whom
rc = Socket('Terminate')
exit 1
end

If TooMany then
do
if ^stack then
say "Too many matches for" whom||'; please be more selective.'
rc = Socket('Terminate')
exit 2
end

If BadQuery then
do
if ^stack then
say "Query not resolved; possibly bad parameters."
rc = Socket('Terminate')
exit 3
end

if OK < 1 then
do
/* try for repeated reads */
do while OK < 1
bytes_read = Socket('Read', s, 'buffer2')
if bytes_read = -1 then
do
call qsay("Severe Error: Second read failed with ErrNo:" errno)
OK = 1 /* not!  but done anyway */
exitrc = 5
end
else
do
"PIPE (end \) stem rawdata.",
"| a: fanin",
"| stem rawdata.",
"| find 200:Ok",
"| count lines",
"| var OK",
"\ var buffer2 ",
"| deblock linend 25 ",
"| a:"
end
end
end
/* hang up from application */
data       = "quit"||'0D25'x
bytes_sent = Socket('Write', s, data)
/*
**   Tell RXSOCKET that we are done with this IUCV path
*/
rc = Socket('Terminate')
If rc="-1" Then Call Error "TERMINATE", errno

if stackall then
do
"PIPE stem rawdata. | stack" /* give it all */
exit
end

if unique then
do
if howmany = 1 then
"PIPE stem rawdata. | stack" /* give it all */
else
exitrc = 8
exit exitrc
end

do i = 1 to howmany
ph.i. = ''                           /* set default value          */
"PIPE (name NewPH1) stem rawdata.",
"| locate /:"||i||":/",
"| specs 9-* 1",                   /*    strip off line prefixes */
"| strip trailing",
"| stem ph."||i||'.'
end
ph.0 = howmany

/* set up windowing environment */
"QUERY DISPLAY (LIFO"
parse pull . lines cols devtype addrtype dbcs color exthi pss pssets
/* wlines = (lines * .75)%1
wcols = (cols * .75)%1
Wpsline = lines%8
Wpscol = cols%8 */
wlines = lines-2 /* allow for borders */
wcols = cols - 4 /* allow for borders again */
Wpsline = 2
Wpscol = 3
Vlines = wlines - 2
Vcols = wcols - 1
VProtTop = 1                          /* protected lines at top     */
VProtBot = 1                          /* protected lines at bottom  */
"WINDOW DEFINE  PH" Wlines Wcols Wpsline Wpscol "(BOR VAR"
"VSCREEN DEFINE PH" Vlines Vcols VProtTop VProtBot "(PROT"
"WINDOW SHOW PH ON PH"
"VMFCLEAR"

/* Now we start to display entries, one at a time. */
i=1
done = 0
parse var whom aa ' return ' .
do while ^done
Ftitle = "PH Lookup Entry:" aa i "of" ph.0
Flen   = length(Ftitle) + 1
Fcol   = (vcols-flen)%2
"VSCREEN WRITE PH 1" fcol flen "(RES HI PROT FIELD" Ftitle
if stack then
select
when ph.0 = 1 then
PFMenu = 'F1: Help F3: Quit F5: Accept                    F12: Done'
when i = ph.0 then
PFMenu = 'F1: Help F3: Quit F5: Accept F7: Prior          F12: Done'
when i = 1 then
PFMenu = 'F1: Help F3: Quit F5: Accept           F8: Next F12: Done'
otherwise
PFMenu = 'F1: Help F3: Quit F5: Accept F7: Prior F8: Next F12: Done'
end /* select */
else
select
when ph.0 = 1 then
PFMenu = 'F1: Help F3: Quit                              '
when i = ph.0 then
PFMenu = 'F1: Help F3: Quit            F7: Prior         '
when i = 1 then
PFMenu = 'F1: Help F3: Quit                      F8: Next'
otherwise
PFMenu = 'F1: Help F3: Quit            F7: Prior F8: Next'
end /* select */
"VSCREEN WRITE PH -1 1" length(pfmenu)+1 "(RES FIELD" PFMenu
do j = 1 to ph.i.0
"VSCREEN WRITE PH" j+1 1 length(ph.i.j)+1 "( HI PROT FIELD" ph.i.j
end                                  /*    for each line of entry  */

if ph.i.0 = 0 then
do
if ^stack then
call qsay("Severe Error: 0 fields present for" i)
abort = 1                                /* ending early     */
done = 1
exitrc = 6
leave
end
else
"VSCREEN WAITREAD PH"              /* wait for user input        */
/* now waitread.0 is the variable count,                           */
/* waitread.1 is the attention key just used,                      */
/* waitread.2 is the cursor position.                              */
/* all variables after those are changed fields.                   */

parse var waitread.1 ktype num
select
when (ktype = "PFKEY") & (find("1 13",num) /= 0) then
call qsay(helpstuff)
when (ktype = "PFKEY") & (find("5 17",num) /= 0) then
done = 1
when (ktype = "PFKEY") & (find("3 15",num) /= 0) then
do
abort = 1                              /* ending early     */
done = 1
end
when (ktype = "PFKEY") & (find("12 24",num) /= 0) then
do
abort = 1                              /* ending early     */
done = 1
if stack then
exitrc = 7                             /* really quit      */
end
when (ktype = "PFKEY") & (find("7 19",num) /= 0) then
do
if i > 1 then
i = i-1
else
call qsay("Already at the first entry.")
end
when (ktype = "PFKEY") & (find("8 20",num) /= 0) then
do
if i < ph.0 then
i = i+1
else
call qsay("That's the last entry.")
end
when ktype = "PFKEY" then
call qsay("PFKey" num "was used.  That's fine, nothing wrong",
"with that, it just doesn't do anything special. ")
otherwise
nop                                      /* no biggie        */
end
if done & ^abort then              /* we have a winner....       */
if stack then
"PIPE STEM PH.I. | stack LIFO"

"VSCREEN CLEAR PH"

end                                    /* wander through entries     */

"WINDOW  DELETE PH"
"VSCREEN DELETE PH"

Exit exitrc

somehelp:
say 'Give a name and get local directory information.'
exit 100                      /* non-zero RC for explanation mode     */

morehelp:
say 'Give a name and get local directory information.'
say 'By default, it looks for you and returns brief information from'
say 'Notre Dame.  Options include who you are looking for, where from,'
say 'and if you want all the server knows about the person.'
say 'Use "*" as the wildcard character.'
say ''
say 'Specify HOST by name, PORT by decimal number.  STACK, STACKALL,'
say 'and UNIQUE are other CMS programs to use.'
say 'Syntax:' progfn '{whom} {( {HOST host} {PORT port}'
say             '{STACK|STACKALL|UNIQUE} }'
exit 100


Qsay:                        /* cheap SAY command for fullscreen     */
procedure
parse arg message

"QUERY DISPLAY (LIFO"
parse pull . lines cols devtype addrtype dbcs color exthi pss pssets
wlines = (lines * .75)%1
wcols = (cols * .75)%1
Wpsline = lines%8
Wpscol = cols%8
Vlines = wlines - 2
Vcols = wcols - 1
VProtTop = 1                          /* protected lines at top     */
VProtBot = 1                          /* protected lines at bottom  */
"WINDOW DEFINE  QUICKIE" Wlines Wcols Wpsline Wpscol "(BOR VAR"
"VSCREEN DEFINE QUICKIE" Vlines Vcols VProtTop VProtBot "(PROT"
"WINDOW SHOW QUICKIE ON QUICKIE"
PFMenu = 'Hit <ENTER> to Continue'
a=(vcols-length(pfmenu))%2
"VSCREEN WRITE QUICKIE -1" a length(PFMenu)+1 "(RES FIELD" PFMenu
fields = 1
Field.Row.1   = 1
Field.title.1 = "Quick Message"
Field.len.1   = length(Field.title.1) + 1
Field.col.1   = (vcols-field.len.1)%2
Field.opts.1  = "HI PROT"

parse var message nextword message
fields = fields + 1
field.title.fields = ''

do while nextword ^= ''
if length(nextword) > vcols then
do
say "Too long word:" nextword
say "No message sent."
return
end
if length(nextword) + length(field.title.fields) < vcols then
do
field.title.fields = field.title.fields nextword
parse var message nextword message
end
else
do
fields = fields+1
field.title.fields = ''
end
end
do i = 2 to fields
Field.Row.i   = i
Field.len.i   = length(Field.title.i) + 1
Field.col.i   = 1
Field.opts.i  = "HI PROT"
end

do i = 1 to fields
"VSCREEN WRITE QUICKIE"  Field.row.i Field.col.i Field.len.i,
    "(" Field.opts.i "FIELD" Field.title.i
if length(field.title.i) >= field.len.i then
say "Trouble: field" i
end
"VSCREEN WAITREAD QUICKIE"           /* wait for user input        */

"VSCREEN CLEAR QUICKIE"
"WINDOW  DELETE QUICKIE"
"VSCREEN DELETE QUICKIE"

return

get_target:

data       = 'fields'||'0D25'x
bytes_sent = Socket('Write', s, data)
if bytes_sent = -1 then
do
say "Write failed.  Errno:" errno
rc = Socket('Terminate')
exit 5
end
bytes_read = Socket('Read', s, 'buffer')
if bytes_read = -1 then
do
say "Read failed.  Errno:" errno
rc = Socket('Terminate')
exit 5
end

"PIPE (end \) var buffer ",
"| deblock linend 25 ",
"| stem rawdata.",
"| b: nfind 200:Ok",
"| e: nfind 598:",
"| find 500:Did not understand query",
"| f: faninany",
"| count lines",
"| var badquery",
"\ b:",
"| count lines",
"| var OK",
"\ e:",
"| f:"

If BadQuery then
do
say "Severe error: fields query failed."
exit 3
end

if OK < 1 then
do
/* try for repeated reads */
do while OK < 1
bytes_read = Socket('Read', s, 'buffer2')
if bytes_read = -1 then
do
say "Severe Error: Second read failed with ErrNo:" errno
ok = 1 /* not!, but done anyway */
exitrc = 5
end
else
do
"PIPE (end \) stem rawdata.",
"| a: fanin",
"| stem rawdata.",
"| find 200:Ok",
"| count lines",
"| var OK",
"\ var buffer2 ",
"| deblock linend 25 ",
"| a:"
end
end
end

/* display code goes here. */
do i = 1 to rawdata.0
parse var rawdata.i msg ':' id ':' stuff
rawdata.i = msg||':'||right(id,2,'0')||":" stuff
end
'PIPE (end \) stem rawdata. ',
'| sort 1.8',
'| a: unique 1.8 first',
'| locate /Public/',
'| locate /Indexed/',
'| buffer', /* when in doubt.... */
'| b: lookup 1.8 master',
'| specs 10-* 1',
'| split /:/',
'| pad 10',
'| join',
'| stem indices.',
'\ a:',
'| buffer', /* when in doubt.... */
'| b:',
'| hole'

stuff.1 = 'Your query must include one of the following keys and'
stuff.2 = '(probably) by default implies "name =" unless you specify'
stuff.3 = 'the keys yourself:'
stuff.1='Type the name (first, last, nickname or a combination) of the'
stuff.2='person you wish to look up.'
stuff.3=''
stuff.4="Or, for lookups involving information other than the person's"
stuff.5="name, use the following keywords:"
do i = 1 to indices.0
j = i+5
stuff.j = indices.i
end
stuff.0 = 3+indices.0

"QUERY DISPLAY (LIFO"
parse pull . lines cols devtype addrtype dbcs color exthi pss pssets
Pscreen = "PHCMSQ"
Pwindow = "PHCMSQ"
Wlines = lines - 4
Wcols = cols - 4
Wpsline = 3
Wpscol = 3
Vlines = wlines - 1
Vcols = wcols - 1
VProtTop = 1                           /* protected lines at top     */
VProtBot = 1                           /* protected lines at bottom  */

"VMFCLEAR"                   /* clear the screen if possible/easy    */
"WINDOW DEFINE"  Pwindow Wlines Wcols Wpsline Wpscol "(BOR VAR"
"VSCREEN DEFINE" Pscreen Vlines Vcols VProtTop VProtBot "(PROT"
"WINDOW SHOW" Pwindow "ON" Pscreen
PFMenu = 'PF Keys: 3: Quit  5: Go 12: Quit'
"VSCREEN WRITE" Pscreen  "-1 1" length(PFMenu)+1 "(RES FIELD" PFMenu

fields = 3 + stuff.0         /* count of currently known fields      */
done = 0
abort = 0
qpt1 = ''
qpt2 = ''

do i = 1 to fields
Field.opts.i = 'PROTECT'
Field.change.i = 1         /* write all lines to ensure state.     */
end
/* now define fields to be used later.                               */
Field.Row.1   = 1
Field.title.1 = "PH Input Screen"
Field.len.1   = length(Field.title.1) + 1
Field.col.1   = (cols-Field.len.1)%2
Field.opts.1 = "RES NOHIGH PROTECT"

Field.row.2   = 3
Field.col.2   = 3
Field.title.2 = left(qpt1,65,' ')
Field.len.2   = length(Field.title.2) + 1
Field.opts.2 = "NOHIGH NOPROTECT"

Field.row.3   = 4
Field.col.3   = 3
Field.len.3   = 66
Field.title.3 = copies(' ',65)
Field.opts.3 = "NOHIGH NOPROTECT"

lastrow = 5  /* don't write message lines in row 5 or above. */

do i = 1 to stuff.0
lastrow = lastrow + 1
j = i+3
Field.row.j = lastrow
Field.col.j = 3
Field.Title.j = stuff.i
Field.len.j = length(stuff.i) + 1
Field.opts.j = "PROTECT HIGH"
end

/* Set the initial cursor position */
CurPosRow = Field.row.2                /* start on first query field */
CurPosCol = Field.col.2 + 1

do while done /= 1
do i = 1 to fields
if Field.change.i then
do
if Field.title.i = '' then
"VSCREEN WRITE" Pscreen  Field.row.i Field.col.i Field.len.i,
"(" Field.opts.i
else
"VSCREEN WRITE" Pscreen  Field.row.i Field.col.i Field.len.i,
"(" Field.opts.i "FIELD" Field.title.i
Field.change.i = 0              /* Reset flag                 */
if length(field.title.i) >= field.len.i then
say "Trouble: field" i
end
end

"VSCREEN CURSOR" Pscreen CurPosRow  CurPosCol
"VSCREEN WAITREAD" Pscreen           /* wait for user input        */
/* now waitread.0 is the variable count,                           */
/* waitread.1 is the attention key just used,                      */
/* waitread.2 is the cursor position.                              */
/* all variables after those are changed fields.                   */
parse var waitread.1 ktype num
if ktype = "PFKEY" & find("3 12 15 24",num) /= 0 then
do
abort = 1                                  /* ending early     */
done = 1
leave  /* don't process changes      */
end
if ktype = "CLEAR" then
do
abort = 1                                  /* ending early     */
done = 1
leave  /* don't process changes      */
end
if ktype = "PFKEY" & find("5 17",num) /= 0 then
done = 1
if ktype = "ENTER" then
done = 1

parse var waitread.2 . CurPosRow CurPosCol .

DO varcount= 3 to waitread.0                   /* changed fields   */
PARSE VAR waitread.varcount KWord ChngRow ChngCol NewVal
SELECT
WHEN ChngRow= 3 THEN                            /* query pt 1  */
DO
qpt1 = NewVal
field.change.2 = 1
field.title.2 = qpt1
End
WHEN ChngRow= 4 THEN                           /* query part 2 */
DO
qpt2 = NewVal
field.change.3 = 1
field.title.3 = qpt2
End
OTHERWISE
say "Error: unrecognized changed field."
say waitread.varcount
END  /* select on changed fields   */
END  /* parse changed fields       */
end  /* do while not done loop               */
"VSCREEN CLEAR"  Pscreen
"WINDOW  DELETE" Pwindow
"VSCREEN DELETE" Pscreen

whom = strip(qpt1) strip(qpt2)
data = 'query' whom||'0D25'x

return
:READ  GL       EXEC     A1 TMP200 06/29/92 10:24:28
/*
 *        Name: GL EXEC, Gopher Tree Traverser (Gopher List)
 *      Author: Rick Troth, Rice University, I/S VM Systems Support
 *        Date: 1992-Feb-22, Jun-29
 *
 *        Note: Think of this as a FILELIST replacement.
 *              Actually, it doesn't replace,  but wraps around
 *              FILELIST,  resetting PF11 from XEDIT to EXEC GL.
 *              When GL is invoked on a FILELIST,  it calls FILELIST;
 *              when GL is invoked on any other file,  it calls XEDIT.
 */

Address "COMMAND"

Parse Upper Arg fn ft fm rest
If fn ^= "" & ft = "" Then ft = "FILELIST"

If ft = "FILELIST" Then Do
    Push "COMMAND SET PF11 BEFORE MACRO" ,
        "EXECUTE CURSOR EXEC GL /"
    'EXEC FILELIST' fn ft fm '(FILELIST'
    End

Else 'XEDIT' fn ft fm rest

Exit rc

:READ  GOPHERCA EXEC     A1 TMP200 01/05/93 17:58:01
/*
 *        Name: GOPHERCAT EXEC
 *
 *        Date: 1993-Jan-05
 *    See also: gophercat (perl script) by Prentiss Riddle
 */

Address "COMMAND"

'SET LANGUAGE (ADD GOP USER'

Parse Arg host port path '(' . ')' .

Parse Var path 1 type 2 slash 3 .
If slash ^= '/' Then Do
    type = '0'
    path = "0/" || path
    End  /*  If  ..  Do  */

item = type || '05'x || path || '05'x ,
            || host || '05'x || port

If type = '0' | type = '1' Then
'PIPE VAR ITEM | GOPCLTCP | GOPCLTXT | CONSOLE'
Else
'PIPE VAR ITEM | GOPCLTCP | CONSOLE'

Exit rc

:READ  GOPGEN   EXEC     A1 TMP200 01/25/93 15:37:32
/*
 *        Name: GOPGEN EXEC
 *              Generate files used by the CMS Gopher server
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-22
 */

Parse Upper Arg what args '(' opts ')' .

Select  /*  what  */

    When  Abbrev("INDEX",what,1)    Then  Signal  INDEX
    When  Abbrev("MESSAGES",what,1) Then  Signal  MESSAGES
    When  Abbrev("MSGS",what,1)     Then  Signal  MESSAGES
    When  Left(what,6) = "GOPCLI"   Then  Signal  REXX
    When  Left(what,6) = "GOPSRV"   Then  Signal  REXX
    When  Abbrev("EDIT",what,1)     Then  Signal  EDIT

    Otherwise Do
        'XMITMSG 3 WHAT (ERRMSG'
        rc = 24
        End  /*  Otherwise  Do  */

    End  /*  Select  what */

Exit rc



/* ------------------------------------------------------------ MESSAGES
 */
MESSAGES:

Parse Var args lang .
If lang = "" Then ft = "MESSAGES"
             Else ft = "MSG" || lang

Address "CMS" 'STATE GOPUME' ft '*'
'PIPE COMMAND LISTFILE GOPUME' ft '* (NOHEADER | TAKE | VAR FILESPEC'
If rc ^= 0 Then Return
Parse Var filespec . ft fm .

'GENMSG GOPUME' ft fm 'GOP' lang '(NOLIST'
If rc ^= 0 Then Return

If lang ^= "" Then Do
    Address "COMMAND" 'STATE GOPUME TEXT' fm
    If rc ^= 0 Then Return
    ft = "TXT" || lang
    'ERASE GOPUME' ft fm
    If rc ^= 0 Then Return
    'RENAME GOPUME TEXT' fm '=' ft fm
    If rc ^= 0 Then Return
    End  /*  If  ..  Do  */

'SET LANG' lang '(ADD GOP USER'
If rc ^= 0 Then Return
'XMITMSG 9999 (APPLID GOP CALLER GEN ERRMSG'

Return



/* --------------------------------------------------------------- INDEX
 */
INDEX:

Parse Var args menu .
'PIPE GOPSRVLS' menu '| GOPGENFL | > VMGOPHER FILELIST A'
If rc ^= 0 Then Return
Say 'WISHLG' menu 'FILELIST A' menu 'GOPINDEX A'
'WISHLG VMGOPHER FILELIST A' menu 'GOPINDEX A'
If rc ^= 0 Then Return
'ERASE VMGOPHER FILELIST A'
If rc ^= 0 Then Return

/*  menu "index created"  */
/*  'XMITMSG ??? MENU (APPLID GOP CALLER GEN ERRMSG'  */

Return



/* ---------------------------------------------------------------- REXX
 */
REXX:

Parse Var args fn ft .
'EXEC EXECUPDT' fn ft '(CTL VMGOPHER'

Return



/* ---------------------------------------------------------------- EDIT
 */
EDIT:

Parse Var args fn ft fm .
'XEDIT' fn '$' || ft fm '(CTL VMGOPHER'

Return

:READ  GOPGENFL REXX     A1 TMP200 01/22/93 10:25:19
/*
 *        Name: GOPGENFL REXX
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1993-Jan-22
 *
 *       Input: FILELIST records, comments allowed
 *      Output: WISHLG input FILELIST records, comments stripped,
 *              title appended to each record that lacked
 *    Calld by: GOPGEN EXEC via PIPE
 */

uc = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
lc = "abcdefghijklmnopqrstuvwxyz"

Do Forever

    'PEEKTO RECORD'
    If rc ^= 0 Then Leave

    If Left(record,1) = ' ' Then Do
        Parse Var record fn ft fm title
        If title = "" Then 'OUTPUT' record Translate(fn||'.'||ft,lc,uc)
                      Else 'OUTPUT' record
        If rc ^= 0 Then Leave
        End  /*  If  ..  Do  */

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  Forever  */

Exit rc * (rc ^= 12)

:READ  GOPHER   HELPCMS  A1 TMP200 01/12/93 19:32:06
.cm This CMS HELP file created by hand - RMT
.cm

GOPHER EXEC

The CMS Gopher client retrieves documents from "gopher servers" and displays
them on your screen.  Gopher servers run on a variety of hosts on InterNet,
and the Gopher protocol allows them to interact with clients on any platform
regardless of the operating system, local file conventions, or character set.

The format of the GOPHER command is:
+---------------------------------------------------------------+
|            |                                                  |
|   GOPHER   |   [host   [port]]   [   (PATH    itempath        |
|            |                     |   (BOOKMARK bookmark       |
|            |                     |   (BOOKLIST                |
|            |                                                  |
|            |                         (TUBE    vaddr   ]       |
|            |                                                  |
+---------------------------------------------------------------+

Gopher is something that you "get into".  That means that command line
options and parameters only affect start-up.  Once you are in Gopher,  the
session is controlled using program function keys,  not with commands.

Function Keys:

        The function keys are usually set to:

                PF1         HELP
                PF3         go back to the previous screen
                PF6         find a string in the current file or menu
                PF7         scroll backward
                PF8         scroll forward
                PF9         set or delete a bookmark
                PF10        list bookmarks
                PF11        view the selected file or menu
                PF12        quit and return to CMS

Options:

        (PATH       path        tells Gopher to read its start-up menu
                                from a particular directory path

        (BOOKMARK   bookmark    resumes viewing from the specified bookmark

        (BOOKLIST               provides a list of all of your bookmarks

        the above options are mutually exclusive

        (TUBE       vaddr       indicates that terminal I/O should
                                be directed to the virtual address,
                                rather than to the CMS console

GlobalVs:

Gopher honors the following user settable GLOBALVs (CMS Global Variables):

        HOST
        PORT
        PATH
        NAME
        TELNET
        TN3270
        VIEWER

These are all in GLOBALV group GOPHER.   To set,  say,  the default gopher
server host,  issue the command:

        GLOBALV SELECT GOPHER SETP HOST host.domain

where  host.domain  is the domain-style name for the gopher server host.

:READ  BROWSER  HELPGOPH A1 TMP200 01/13/93 14:01:27
.cm This CMS HELP file created by hand - RMT
.cm

CMS Gopher - Viewing Directories

You are presented with a menu of items.  These may be files, directories
of files, links to other Gopher servers, or other special functions.
To "open" an item, place your cursor on or under the item then press <ENTER>.

Before each item is symbolic text explaining what type of item it is:

        <document>  (nothing), this item is a plain-text file
        <menu>      this item leads to another directory or Gopher
        <phonebk>   this item leads to a CSO/qi Phonebook search
        <search>    this item leads to a keyword search
        <telnet>    this item represents a telnet session
.cm     <)          "sound" (looks like a speaker), not supported on CMS
.cm     <O>         PostScript (looks like an eye), not supported on CMS
        <picture>   this item is a graphic
                    (requires a grphics terminal to view)
        <binary>    this item is a "binary" file
                    (not interesting to view,  but downloadable)

Function keys active are:

        ENTER       select an item
        PF1         help (gives you this screen)
.cm     PF2         select an item (same as ENTER)
        PF3         go back to previous menu (if any)
        PF6         find particular string within the menu
        PF7         Scroll UP in the menu
        PF8         Scroll DOWN in the menu
        PF9         set a BOOKMARK on this panel
                    (or delete the BOOKMARK at the cursor
                    if you're viewing your bookmark list)
        PF10        go to the BOOKMARK list/select panel
.cm     PF11        display host/port/path to selected item
        PF12        quit entirely

:READ  VIEWER   HELPGOPH A1 TMP200 01/12/93 19:25:11
.cm This CMS HELP file created by hand - RMT
.cm

CMS Gopher - Viewing Files

The item you selected is a plain text file.  You may browse this file,  use
the CMS editor (XEDIT) to make changes and/or save it to disk,  or print it.

Function keys active are:

        PF1         help (gives you this screen)
.cm     PF2         pass the file off to XEDIT
        PF3         go back to the menu
        PF4         print the file
        PF6         find a particular string in this file
        PF7         Scroll UP in the file
        PF8         Scroll DOWN in the file
        PF9         set a BOOKMARK referencing this file
        PF10        go to the BOOKMARK list/select panel
.cm     PF11        display host/port/path to this file
        PF12        quit

You can override the internal viewer by setting the Global Variable VIEWER.
For example,  if you prefer to use the LEXX editor to view gopher files,

        GLOBALV SELECT GOPHER SETLP VIEWER LEXX

                ... would cause LEXX to be used to display gopher files.

:READ  GOP000I  HELPMSG  A1 TMP200 01/25/93 01:24:55

000I      Rice CMS Gopher 2.4.0

Explanation:    This is Rice University's CMS Gopher v2 r4.
                Message number zero is merely program identification.

System Action:  none

User Response:  none

:READ  GOPGEN   HELPCMS  A1 TMP200 01/22/93 10:50:28
.cm
.cm       Name: GOPGEN HELPCMS
.cm             help for GOPGEN EXEC
.cm     Author: Rick Troth, Rice University, Information Systems
.cm       Date: 1993-Jan-22
.cm
.cm             Yes, this was created by hand.
.cm

 GOPGEN EXEC

 Use GOPGEN to generate files used by the CMS Gopher client and server.
 Use GOPGEN to create the INDEX file used by the server for keyword searches.
 Use GOPGEN to rebuild the message repository for your local language.

 +--------------+-----------------------------------------------------+
 |              |                                                     |
 |   GOPGEN     |   INDEX      menu                                   |
 |              |                                                     |
 |              |   MESSAGES   [language]                             |
 |              |   MSGS                                              |
 |              |                                                     |
 |              |   program                                           |
 |              |                                                     |
 +--------------+-----------------------------------------------------+

ó|Operationsó%

 INDEX
     uses WISHLG to generate a keyword index on the files in a menu.
     The menu must be defined by a FILELIST or an SFS sub-directory.
     You must place the indexfile,  menu GOPINDEX,  where the server
     can access it,  either on the minidisk where the FILELIST resides
     or in the SFS directory that was indexed.

 MESSAGES
     for non-AMENG sites,  after translating the message repository
     source into your local language,  rename the source accordingly.
     GOPGEN will invoke GENMSG to create a message repository object file.

 program
     after applying local modifications with XEDIT (CTL VMGOPHER,
     GOPGEN runs EXECUPDT to create a new EXEC or REXX pipeline stage.
     After testing to verify correct operation,  place this file on the
     minidisk or in the SFS directory where the rest of CMS Gopher resides.

:READ  GOPHERDH REXX     A1 TMP200 06/25/92 13:22:17
/*
 *        Name: GOPHERDH REXX
 *              pipeline stage for interpreting the CMS HELP database
 *      Author: Rick Troth, Rice Univ, I/S VM Systems Support
 *        Date: 1992-Apr-25, Jun-24
 *
 *              This gem is supplied with Rice CMS GopherD.
 */

/*  accept a command line;  remember options  */
Parse Upper Arg item '(' opts

/*  the "item" may have leading "path" parts,  which we just ignore   */
Do While Index(item,'/') > 0; Parse Var item . '/' item; End

/*  make it right  */
If Words(item) = 0 Then item = "TASK HELP"
If Words(item) = 1 Then topic = "CMS"
                   Else Parse Var item topic item .

/*  is it a task? menu? or leaf item?  */
If item = "TASK" Then Do; item = topic; topic = "TASK"; End
If item = "MENU" Then Do; item = topic; topic = "MENU"; End

/*  call the right pipeline stages  */
Select  /*  topic  */

    When topic = "TASKTEXT" Then Call HELPTEXT
    When topic = "MENUTEXT" Then Call HELPTEXT

    When topic = "TASK" Then Call HELPTASK
/*      'CALLPIPE DISK' item 'HELPTASK * | HELPTASK' item '| *:'      */

    When topic = "MENU" Then CALL HELPMENU
/*      'CALLPIPE DISK' item 'HELPMENU * | HELPMENU' item '| *:'      */

    Otherwise                CALL HELPITEM
/*      'CALLPIPE COMMAND HELP' topic item '(NOSCREEN' opts '| *:'    */

    End  /*  Select  topic  */

Exit



/* ------------------------------------------------------------ HELPITEM
 */
HELPITEM:

'CALLPIPE COMMAND HELP' topic item '(NOSCREEN' opts '| *:'

Return



/* ------------------------------------------------------------ HELPTEXT
 */
HELPTEXT:

/*  it would be way-cool if we could present the preliminary text     *
 *  ("user instructions",  or whatever you want to call it)           *
 *  as a plain-text item from the menu we're creating here.           */

If topic = "MENUTEXT" Then 'ADDPIPE DISK' item 'HELPMENU * | *.INPUT:'
                      Else 'ADDPIPE DISK' item 'HELPTASK * | *.INPUT:'

/* read and replay displayed text or "user instructions" from task */
'PEEKTO LINE'
Do While rc = 0
    If Strip(line) = "" & Strip(prev) = "" Then Leave

    If Left(line,1) ^= '.' Then Do
        /* remove any HELP control sequences */
        p = Index(line,'4A'x)
        Do While p > 0
            line = Left(line,p-1) || Substr(line,p+2)
            p = Index(line,'4A'x)
            End
        /* and send this line of text down the pipe */
        'OUTPUT' line
        End

    prev = line
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

Return



/* ------------------------------------------------------------ HELPTASK
 */
HELPTASK:

'ADDPIPE DISK' item 'HELPTASK * | *.INPUT:'

/* first consume the displayed text or "user instructions" */
'PEEKTO LINE'
Do While rc = 0
    If Strip(line) = "" & Strip(prev) = "" Then Leave
/*  If Left(line,1) ^= '.' Then 'OUTPUT' line  */
    prev = line
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

'OUTPUT' "0" || item "task heading text" || '05'x || ,
         "0" || "TASKTEXT" item

/* now interpret the task lines and make a menu */
'PEEKTO LINE'
Do While rc = 0
    If Left(line,1) ^= '.' & Strip(line) ^= "" Then Do
        /* ignoring blank lines and control lines */
        Parse Var line 1 path 25 title

        /* remove HELP control sequences from titles */
        p = Index(title,'4A'x)
        Do While p > 0
            title = Left(title,p-1) || Substr(title,p+2)
            p = Index(title,'4A'x)
            End

        type = "0"
        Parse Upper Var path topic item .
        If item = "TASK" Then Do; item = topic; topic = "TASK"; End
        If item = "MENU" Then Do; item = topic; topic = "MENU"; End
        If topic = "TASK" | topic = "MENU" Then type = "1"
        'OUTPUT' type || title || '05'x || type || topic item
/*      'OUTPUT' type || title || '05'x || type || path               */
        End  /*  If  ..  Do  */

    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

Return



/* ------------------------------------------------------------ HELPMENU
 */
HELPMENU:

'ADDPIPE DISK' item 'HELPMENU * | *.INPUT:'

topic = item

'PEEKTO LINE'
Do While rc = 0
    If Strip(line) = "" & Strip(prev) = "" Then Leave
    prev = line
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

'OUTPUT' "0" || item "menu heading text" || '05'x || ,
         "0" || "MENUTEXT" item

'PEEKTO LINE'
Do While rc = 0
    If Left(line,1) ^= '.' & Strip(line) ^= "" Then Do
        Parse Var line item .
        key = Left(item,1)
        Select  /*  key  */
            When key = '*' Then
                'OUTPUT' "1" || line || '05'x ||  ,
                    "1" || "MENU" Substr(item,2)
            When key = ':' Then
                'OUTPUT' "1" || line || '05'x || ,
                    "1" || "TASK" Substr(item,2)
            Otherwise
                'OUTPUT' "0" || line || '05'x || ,
                    "0" || topic item
            End  /*  Select  key  */
        End  /*  If  ..  Do  */
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

Return

:READ  GOPHERDI REXX     A1 TMP200 01/18/93 18:52:10
/*
 *        Name: GOPHERDH REXX (GOPHERDI)
 *              pipeline stage for interpreting the CMS HELP database
 *      Author: Rick Troth, Rice University, Information Systems
 *        Date: 1992-Apr-25, Jun-24, Jul-29, 1993-Jan-18
 *
 *              This gem is supplied with the Rice CMS Gopher server.
 *              Feel free to use it as an example of building
 *              your own Gopher server smart pipeline stages.
 */

Parse Source . . . . . arg0 .
argo = arg0 || ':'
Parse Arg args
Say argo args

/*  accept a command line;  remember options  */
Parse Upper Arg item '(' opts ')' .

/*  the "item" may have leading "path" parts,  which we just ignore   */
Do While Index(item,'/') > 0; Parse Var item . '/' item; End

/*  make it right  */
If Words(item) = 0 Then item = "TASK HELP"
If Words(item) = 1 Then topic = "CMS"
                   Else Parse Var item topic item .

/*  is it a task? menu? or leaf item?  */
If item = "TASK" Then Do; item = topic; topic = "TASK"; End
If item = "MENU" Then Do; item = topic; topic = "MENU"; End

/*  call the right pipeline stages  */
Select  /*  topic  */

    When topic = "TASKTEXT" Then Call HELPTEXT
    When topic = "MENUTEXT" Then Call HELPTEXT

    When topic = "TASK"     Then Call HELPTASK

    When topic = "MENU"     Then CALL HELPMENU

    Otherwise                    CALL HELPITEM

    End  /*  Select  topic  */

Exit rc



/* ------------------------------------------------------------ HELPITEM
 *  Neither a TASK nor a MENU node;  this is a leaf.
 */
HELPITEM:

'CALLPIPE COMMAND HELP' topic item '(NOSCREEN' opts '| *:'

Return



/* ------------------------------------------------------------ HELPTEXT
 *  This section is a left-over from the pre-Panda version.
 *  It is still called if you invoke the older HELPTASK or HELPMENU.
 */
HELPTEXT:

/*  it would be way-cool if we could present the preliminary text     *
 *  ("user instructions",  or whatever you want to call it)           *
 *  as a plain-text item from the menu we're creating here.           */

If topic = "MENUTEXT" Then 'ADDPIPE <' item 'HELPMENU * | *.INPUT:'
                      Else 'ADDPIPE <' item 'HELPTASK * | *.INPUT:'
If rc ^= 0 Then Return

/* read and replay displayed text or "user instructions" from task */
Do Forever

    'PEEKTO LINE'
    If rc ^= 0 Then Leave

    If Strip(line) = "" & Strip(prev) = "" Then Leave

    If Left(line,1) ^= '.' Then Do
        /* remove any HELP control sequences */
        p = Index(line,'4A'x)
        Do While p > 0
            line = Left(line,p-1) || Substr(line,p+2)
            p = Index(line,'4A'x)
            End
        /* and send this line of text down the pipe */
        'OUTPUT' line
        If rc ^= 0 Then Leave
        End

    prev = line
    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  Forever  */

Return



/* ------------------------------------------------------------ HELPTASK
 *  Selected item is a TASK.   Presume we have GOPSRVMB following.
 */
HELPTASK:

'ADDPIPE <' item 'HELPTASK * | *.INPUT:'
If rc ^= 0 Then Return

/* first show the displayed text or user instructions as "info" */
Do Forever

    'PEEKTO LINE'
    If rc ^= 0 Then Leave

    If Strip(line) = "" & Strip(prev) = "" Then Leave
    If Left(line,1) ^= '.' Then 'OUTPUT' 'i' || line
    If rc ^= 0 Then Leave
    prev = line

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  Forever  */

/* now interpret the task lines and make a menu */
Do Forever

    'PEEKTO LINE'
    If rc ^= 0 Then Leave

    If Left(line,1) ^= '.' & Strip(line) ^= "" Then Do
        /* ignoring blank lines and control lines */
        Parse Var line 1 path 25 title

        /* remove HELP control sequences from titles */
        p = Index(title,'4A'x)
        Do While p > 0
            title = Left(title,p-1) || Substr(title,p+2)
            p = Index(title,'4A'x)
            End

        type = "0"
        Parse Upper Var path topic item . '(' . ')' .
        If item = "TASK" Then Do; item = topic; topic = "TASK"; End
        If item = "MENU" Then Do; item = topic; topic = "MENU"; End
        If topic = "TASK" | topic = "MENU" Then type = "1"
        'OUTPUT' type || title || '05'x || type || topic item
/*      'OUTPUT' type || title || '05'x || type || path               */
        If rc ^= 0 Then Leave
        End  /*  If  ..  Do  */

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  Forever  */

Return



/* ------------------------------------------------------------ HELPMENU
 *  Selected item is a MENU.   Presume we have GOPSRVMB follows.
 */
HELPMENU:

'ADDPIPE <' item 'HELPMENU * | *.INPUT:'
If rc ^= 0 Then Return

topic = item

/* first show the displayed text or user instructions as "info" */
Do Forever

    'PEEKTO LINE'
    If rc ^= 0 Then Leave

    /* Menu type */
    if left(line,3) = '.mt' then parse var line . topic .

    If Strip(line) = "" & Strip(prev) = "" Then Leave
    If Left(line,1) ^= '.' Then 'OUTPUT' 'i' || line
    If rc ^= 0 Then Leave
    prev = line

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  While  */

Do Forever

    'PEEKTO LINE'
    If rc ^= 0 Then Leave

    /* Menu type */
    if left(line,3) = '.mt' then parse var line . topic .

    If Left(line,1) ^= '.' & Strip(line) ^= "" Then Do
        Parse Var line item .
        key = Left(item,1)
        Select  /*  key  */
            When key = '*' Then
                'OUTPUT' "1" || line || '05'x ||  ,
                    "1" || "MENU" Substr(item,2)
            When key = ':' Then
                'OUTPUT' "1" || line || '05'x || ,
                    "1" || "TASK" Substr(item,2)
            Otherwise
                'OUTPUT' "0" || line || '05'x || ,
                    "0" || topic item
            End  /*  Select  key  */
        If rc ^= 0 Then Leave
        End  /*  If  ..  Do  */

    'READTO'
    If rc ^= 0 Then Leave

    End  /*  Do  While  */

Return



/*  The following two routines are useful if you serve    *
 *  clients that can't handle the Panda "info" type       */



/* ------------------------------------------------------------ HELPTASK
 */
HELPTASK:

'ADDPIPE DISK' item 'HELPTASK * | *.INPUT:'

/* first consume the displayed text or "user instructions" */
'PEEKTO LINE'
Do While rc = 0
    If Strip(line) = "" & Strip(prev) = "" Then Leave
    prev = line
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

'OUTPUT' "0" || item "task heading text" || '05'x || ,
         "0" || "TASKTEXT" item

/* now interpret the task lines and make a menu */
'PEEKTO LINE'
Do While rc = 0
    If Left(line,1) ^= '.' & Strip(line) ^= "" Then Do
        /* ignoring blank lines and control lines */
        Parse Var line 1 path 25 title

        /* remove HELP control sequences from titles */
        p = Index(title,'4A'x)
        Do While p > 0
            title = Left(title,p-1) || Substr(title,p+2)
            p = Index(title,'4A'x)
            End

        type = "0"
        Parse Upper Var path topic item .
        If item = "TASK" Then Do; item = topic; topic = "TASK"; End
        If item = "MENU" Then Do; item = topic; topic = "MENU"; End
        If topic = "TASK" | topic = "MENU" Then type = "1"
        'OUTPUT' type || title || '05'x || type || topic item
/*      'OUTPUT' type || title || '05'x || type || path               */
        End  /*  If  ..  Do  */

    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

Return



/* ------------------------------------------------------------ HELPMENU
 */
HELPMENU:

'ADDPIPE DISK' item 'HELPMENU * | *.INPUT:'

topic = item

/* first consume the displayed text or "user instructions" */
'PEEKTO LINE'
Do While rc = 0
    If Strip(line) = "" & Strip(prev) = "" Then Leave
    prev = line
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

'OUTPUT' "0" || item "menu heading text" || '05'x || ,
         "0" || "MENUTEXT" item

'PEEKTO LINE'
Do While rc = 0
    If Left(line,1) ^= '.' & Strip(line) ^= "" Then Do
        Parse Var line item .
        key = Left(item,1)
        Select  /*  key  */
            When key = '*' Then
                'OUTPUT' "1" || line || '05'x ||  ,
                    "1" || "MENU" Substr(item,2)
            When key = ':' Then
                'OUTPUT' "1" || line || '05'x || ,
                    "1" || "TASK" Substr(item,2)
            Otherwise
                'OUTPUT' "0" || line || '05'x || ,
                    "0" || topic item
            End  /*  Select  key  */
        End  /*  If  ..  Do  */
    'READTO'
    'PEEKTO LINE'
    End  /*  Do  While  */

Return

:READ  HELP     NAMES    A1 TMP200 10/20/92 20:02:39
*
*         Name: HELP NAMES
*               an example of how to automate menu building
*               and file construction/presentation with CMS GopherD
*       Author: Rick Troth, Rice University, I/S VM Systems Support
*         Date: 1992-Apr-25, Jun-24, Jul-31
*
*               This file is supplied with the Rice CMS Gopher server.
*
*         Note: there is no HELP FILELIST to go along with this
*               NAMES file.   When the parent FILELIST references
*               HELP FILELIST,  and it doesn't exist,  the entry for
*               :nick..  (relative path ".")  in this is used.
*
*         Note: the tags :fn. and :ft. are not used in this example
*
*         NOTE! you MUST change the :auth. to match your local subnet
*               (I don't feel good gophering-out IBM documents to
*               the whole world,  and this is the *same* HELP NAMES
*               file that we use at Rice)
*

*
* default pipe specification for any path
:nick.*     :pipe.GOPHERDH &0 (ALL

*
* pipe specification for this menu itself
:nick..     :pipe.GOPHERDH
*
:READ  NEWS     NAMES    A1 TMP200 07/31/92 08:35:58
*
*         Name: NEWS NAMES
*               (see HELP NAMES for a description)
*       Author: Rick Troth, Rice University, I/S VM Systems Support
*         Date: 1992-Jun-25, Jul-31
*

*
* default pipe specification for any path
:nick.*     :pipe.GOPHERDH &0 (ALL      :auth.128.42.0.0

*
* pipe specification for this menu itself
:nick..     :pipe.GOPHERDH TASK NEWS    :auth.128.42.0.0
*
:READ  GOPHER   COPYRIGH A1 TMP200 01/22/93 18:30:37
/*
 *      Copyright 1992, 93 Richard M. Troth.   This software was developed
 *      with resources provided by Rice University and is intended to
 *      serve Rice's user community.   Rice has benefitted greatly from
 *      the free distribution of software,  therefore distribution of
 *      unmodified copies of this material is not restricted.   You may
 *      change your own copy as needed.   Neither Rice University nor
 *      any of its employees or students shall be held liable for damages
 *      resulting from the use of this software.
 */
:READ  GOPCLI   $EXEC    A1 TMP200 01/25/93 15:25:48
/*                                                                      00010000
 *        Name: GOPCLI EXEC                                             00020000
 *              VM TCP/IP Network GOPHER Client                         00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *              Major thanks to Arty Ecock for the wonderful RXSOCKET.  00050000
 *              Thanks to Serge Goldstein for help with many things.    00060000
 *        Date: 1992-Dec-23                                             00070000
 */                                                                     00080000
                                                                        00090000
/*                                                                      00100000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00110000
 *      with resources provided by Rice University and is intended      00120000
 *      to serve Rice's user community.   Rice has benefitted greatly   00130000
 *      from the free distribution of software,  therefore distribution 00140000
 *      of unmodified copies of this material is not restricted.        00150000
 *      You may change your own copy as needed.   Neither Rice          00160000
 *      University nor any of its employees or students shall be held   00170000
 *      liable for damages resulting from the use of this software.     00180000
 */                                                                     00190000
                                                                        00200000
/*                                                                      00210000
 *       Calls:                                                         00220000
 *              RXSOCKET MODULE   -- for TCP/IP network services        00230000
 *              PIPE     MODULE   -- for various I/O functions          00240000
 *              GLOBALV           -- for temp and perm global vars      00250000
 *              XMITMSG           -- for all message output             00260000
 *              VM TCP/IP, V2 or later (through RXSOCKET)               00270000
 *                                                                      00280000
 *              GOPCLINI EXEC     -- to initialize many things          00290000
 *              GOPCLITM REXX     -- to fetch the first item (a menu)   00300000
 *              GOPCLIMB REXX     -- to display a menu (from bookmarks) 00310000
 *                     both of which call other gems                    00320000
 *                                                                      00330000
 *    perm GVs:                                                         00340000
 *        HOST  -  the host to connect to for the root menu             00350000
 *        PORT  -  the port on that host for Gopher service             00360000
 *        PATH  -  the path to the initial menu                         00370000
 *        NAME  -  the name of the initial menu                         00380000
 *      TELNET  -  the name of the CMS TELNET command  (user preference)00390000
 *      TN3270  -  the name of the command for 3270 telnet connections  00400000
 *      VIEWER  -  the CMS command (XEDIT or BROWSE) used to view a file00410000
 *   BOOKMARK.  -  prefix for all bookmark variables,  where what       00420000
 *                 follows the dot is the name of the bookmark          00430000
 *                                                                      00440000
 *    temp GVs:                                                         00450000
 *        TUBE  -  the virtual address of a DIALed terminal (not cons)  00460000
 *      GOPHER  -  the IUCV path name and translate table name          00470000
 *      PROGID  -  program name                                         00480000
 *        ITEM  -  a line of "gopher menu data" for the chosen item     00490000
 *         ...                                                          00500000
 */                                                                     00510000
                                                                        00520000
Trace "OFF"                                                             00530000
                                                                        00540000
Address "COMMAND"                                                       00550000
                                                                        00560000
'SET LANGUAGE (ADD GOP USER'                                            00570000
If rc ^= 0 Then Exit rc                                                 00580000
                                                                        00590000
'STATE PIPE MODULE *'                                                   00600000
If rc ^= 0 Then Do                                                      00610000
    qrc = rc                                                            00620000
    /*  "You must have CMS Pipelines to run CMS Gopher."  */            00630000
    'XMITMSG 3 (APPLID GOP CALLER CLI ERRMSG'                           00640000
    Exit qrc                                                            00650000
    End  /*  If  ..  Do  */                                             00660000
                                                                        00670000
/*  Thanks to Nick LaFlamme for the linemode catcher.  */               00680000
'PIPE COMMAND QUERY DISPLAY'                                            00690000
If rc ^= 0 Then Do                                                      00700000
    qrc = rc                                                            00710000
    'XMITMSG 523 (ERRMSG'       /*  "Typewriter mode"  */               00720000
    /*  "CMS Gopher requires a full-screen terminal."  */               00730000
    'XMITMSG 926 (APPLID GOP CALLER CLI ERRMSG'                         00740000
    Exit qrc                                                            00750000
    End  /*  If  ..  Do  */                                             00760000
                                                                        00770000
'STATE RXSOCKET MODULE *'                                               00780000
If rc ^= 0 Then Do                                                      00790000
    qrc = rc                                                            00800000
    /*  "You must have RXSOCKET to run CMS Gopher."  */                 00810000
    'XMITMSG 1 (APPLID GOP CALLER CLI ERRMSG'                           00820000
    Exit qrc                                                            00830000
    End  /*  If  ..  Do  */                                             00840000
                                                                        00850000
'STATE TCPIP DATA *'                                                    00860000
If rc ^= 0 Then Do                                                      00870000
    qrc = rc                                                            00880000
    /*  "You must have VM TCP/IP V2 to run CMS Gopher."  */             00890000
    'XMITMSG 2 (APPLID GOP CALLER CLI ERRMSG'                           00900000
    Exit qrc                                                            00910000
    End  /*  If  ..  Do  */                                             00920000
                                                                        00930000
Parse Arg host port path '(' options ')' .                              00940000
                                                                        00950000
If host = "" & options = "" Then 'GLOBALV SELECT GOPHER GET PATH NAME'  00960000
                            Else name = ""                              00970000
                                                                        00980000
/* Initialize some variables */                                         00990000
bookmark = ""                                                           01000000
bkl  = 0                                                                01010000
tube = "CONS"                                                           01020000
quit = 0                                                                01030000
                                                                        01040000
/* process options, if any */                                           01050000
Do While options ^= ""                                                  01060000
    Parse Var options op options                                        01070000
    Upper op                                                            01080000
    Select  /*  op  */                                                  01090000
        When    Abbrev("TOPIC",op,2)    | ,                             01100000
                Abbrev("PATH",op,1)     Then Do                         01110000
                    path = options                                      01120000
                    options = ""                                        01130000
                    End  /*  When  ..  Do  */                           01140000
        When    Abbrev("TUBE",op,2)     Then                            01150000
                    Parse Var options tube options                      01160000
        When    Abbrev("BOOKMARK",op,1) | ,                             01170000
                Abbrev("BKMARK",op,3)   Then                            01180000
                    Parse Var options bookmark options                  01190000
        When    Abbrev("BOOKLIST",op,5) | ,                             01200000
                Abbrev("BKLIST",op,3)   Then Do                         01210000
                    bkl = 1                                             01220000
                    End  /*  When  ..  Do  */                           01230000
        When    Abbrev("TITLE",1)       Then Do                         01240000
                    name = options                                      01250000
                    options = ""                                        01260000
                    End  /*  When  ..  Do  */                           01270000
        Otherwise 'XMITMSG 3 OP (ERRMSG'                                01280000
        End  /*  Select  op  */                                         01290000
    End  /*  Do  While  */                                              01300000
                                                                        01310000
/*  initialize many GlobalVs,  including screen stem  */                01320000
'EXEC GOPCLINI' tube                                                    01330000
                                                                        01340000
/*  Now go display first menu or file or bookmark  */                   01350000
Select                                                                  01360000
    When    bkl         Then Call BOOKLIST                              01370000
    When bookmark ^= "" Then Call BOOKMARK                              01380000
    Otherwise                Call SHOWITEM                              01390000
    End  /*  Select  */                                                 01400000
                                                                        01410000
/*  clear some work GlobalVs  */                                        01420000
'GLOBALV SELECT GOPHER SET PROGID'                                      01430000
'GLOBALV SELECT GOPHER SET GOPHER'                                      01440000
'GLOBALV SELECT GOPHER SET TUBE'                                        01450000
'GLOBALV SELECT GOPHER SET ITEM'                                        01460000
'GLOBALV SELECT GOPHER SET COMMAND QUIT'        /* no recursion here */ 01470000
                                                                        01480000
Exit                                                                    01490000
                                                                        01500000
                                                                        01510000
                                                                        01520000
/* ------------------------------------------------------------ SHOWITEM01530000
 */                                                                     01540000
SHOWITEM:                                                               01550000
                                                                        01560000
If host = "" Then 'GLOBALV SELECT GOPHER GET HOST'                      01570000
If host = "" Then host = "gopher.tc.umn.edu"                            01580000
                                                                        01590000
If port = "" Then 'GLOBALV SELECT GOPHER GET PORT'                      01600000
If port = "" Then port = 70                                             01610000
                                                                        01620000
If name = "" Then Do                                                    01630000
    Parse Value Reverse(path) With name '/' .                           01640000
    name = Reverse(name)                                                01650000
    End  /*  If  ..  Do  */                                             01660000
                                                                        01670000
If name = "" Then Do                                                    01680000
    'PIPE COMMAND XMITMSG 4 (APPLID GOP CALLER CLI | VAR NAME'          01690000
    Parse Var name . name                                               01700000
    End  /*  If  ..  Do  */                                             01710000
                                                                        01720000
type = Left(path,1)                                                     01730000
If type = '/' | type = ' ' Then type = '1'                              01740000
                                                                        01750000
item = type || name || '05'x || path || '05'x ,                         01760000
            || host || '05'x || port || '05'x                           01770000
'PIPE VAR ITEM | GOPCLITM OPEN | CONSOLE'                               01780000
                                                                        01790000
Return                                                                  01800000
                                                                        01810000
                                                                        01820000
                                                                        01830000
/* ------------------------------------------------------------ BOOKMARK01840000
 *  Present the selected bookmark or fall-back to the list of all.      01850000
 */                                                                     01860000
BOOKMARK:                                                               01870000
                                                                        01880000
/*  if bookmark was specified numeric,  just fetch it  */               01890000
If Datatype(bookmark,'N') Then Do                                       01900000
    i = Trunc(bookmark)                                                 01910000
    'PIPE COMMAND GLOBALV SELECT GOPHER GET BOOKMARK.' || i             01920000
    If bookmark.i ^= "" Then Do                                         01930000
        'PIPE VAR BOOKMARK.' || i '| GOPCLITM OPEN | CONSOLE'           01940000
        Return                                                          01950000
        End  /*  If  ..  Do  */                                         01960000
    End  /*  If  ..  Do  */                                             01970000
                                                                        01980000
                                                                        01990000
                                                                        02000000
/* ------------------------------------------------------------ BOOKLIST02010000
 *  Present a menu of all of the user's bookmarks.                      02020000
 */                                                                     02030000
BOOKLIST:                                                               02040000
                                                                        02050000
If name = "" Then Do                                                    02060000
    /*  extract personal name from NAMES file  */                       02070000
    Parse Value Diag(08,'QUERY USERID') With user . host . '15'x .      02080000
    'PIPE COMMAND NAMEFIND :USERID' user ':NODE' host ,                 02090000
        ':NAME | VAR PERSONAL'                                          02100000
    If rc = 0 & personal ^= "" Then                                     02110000
        /*  make a title line for bookmark list  */                     02120000
        'PIPE COMMAND XMITMSG 40 PERSONAL' ,                            02130000
            '(APPLID GOP CALLER CLI NOHEADER | VAR NAME'                02140000
    End  /*  If  ..  Do  */                                             02150000
                                                                        02160000
/*  extract bookmarks from GlobalVs  */                                 02170000
'PIPE COMMAND GLOBALV SELECT GOPHER LIST' ,                             02180000
        '| LOCATE 1-10 / BOOKMARK./ | SPEC /=/ 1 2-* NEXT | VARLOAD'    02190000
If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0                        02200000
                             Else bookmark.0 = Trunc(bookmark.0)        02210000
                                                                        02220000
'PIPE STEM BOOKMARK. | GOPCLIMB' name '| CONSOLE'                       02230000
If rc ^= 0 Then Return                                                  02240000
                                                                        02250000
'GLOBALV SELECT GOPHER GET COMMAND'                                     02260000
Parse Upper Var command verb .                                          02270000
If Abbrev("QUIT",verb,1) Then Return                                    02280000
                                                                        02290000
/*  remove any blanked (deleted) bookmarks from the stem  */            02300000
j = 0                                                                   02310000
'GLOBALV SELECT GOPHER GET BOOKMARK.0'                                  02320000
Do i = 1 to bookmark.0                                                  02330000
    'GLOBALV SELECT GOPHER GET BOOKMARK.' || i                          02340000
    If  Symbol("BOOKMARK." || i) = "LIT"    | ,                         02350000
                      bookmark.i = ""       | ,                         02360000
                 Left(bookmark.i,1) = 'i'   Then    Iterate             02370000
    j = j + 1                                                           02380000
    bookmark.j = bookmark.i                                             02390000
    'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || j                         02400000
    End                                                                 02410000
bookmark.0 = j                                                          02420000
'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'                                 02430000
                                                                        02440000
Return                                                                  02450000
                                                                        02460000
:READ  GOPCLINI $EXEC    A1 TMP200 01/25/93 15:25:45
/*                                                                      00010000
 *        Name: GOPCLINI EXEC                                           00020000
 *              CMS InterNet Gopher (client) initialization             00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23, 1993-Jan-22                                00050000
 */                                                                     00060000
                                                                        00070000
/*                                                                      00080000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00090000
 *      with resources provided by Rice University and is intended      00100000
 *      to serve Rice's user community.   Rice has benefitted greatly   00110000
 *      from the free distribution of software,  therefore distribution 00120000
 *      of unmodified copies of this material is not restricted.        00130000
 *      You may change your own copy as needed.   Neither Rice          00140000
 *      University nor any of its employees or students shall be held   00150000
 *      liable for damages resulting from the use of this software.     00160000
 */                                                                     00170000
                                                                        00180000
Trace "OFF"                                                             00190000
                                                                        00200000
Address "COMMAND"                                                       00210000
                                                                        00220000
Parse Upper Arg . '(' opts ')' .                                        00230000
fsin = 1;   load = 1                                                    00240000
Do While opts ^= ""                                                     00250000
    Parse Var opts op opts                                              00260000
    Select  /*  op  */                                                  00270000
        When  Abbrev("UNLOAD",op,3)     Then  Signal  UNLOAD            00280000
        When  Abbrev("NOSCREEN",op,3)   Then  fsin = 0                  00290000
        When  Abbrev("NOLOAD",op,3)     Then  load = 0                  00300000
        When  Abbrev("SCREEN",op,3)     Then  fsin = 1                  00310000
        When  Abbrev("LOAD",op,1)       Then  load = 1                  00320000
        Otherwise 'XMITMSG 3 OP (ERRMSG'                                00330000
        End  Select  /*  op  */                                         00340000
    End  /*  Do  While  */                                              00350000
                                                                        00360000
'SET LANGUAGE (ADD GOP USER'                                            00370000
If rc ^= 0 Then Exit rc                                                 00380000
                                                                        00390000
/*  fetch the program ID string  */                                     00400000
'PIPE COMMAND XMITMSG 0 (APPLID GOP CALLER CLI NOHEADER | VAR PROGID'   00410000
                                                                        00420000
/*  migrate old bookmarks  */                                           00430000
'EXEC GOPHMARK'                                                         00440000
                                                                        00450000
Parse Upper Arg tube . '(' . ')' .                                      00460000
                                                                        00470000
'GLOBALV SELECT GOPHER PUT GOPHER PROGID TUBE'                          00480000
'GLOBALV SELECT GOPHER SET ITEM'                                        00490000
'GLOBALV SELECT GOPHER SET COMMAND'                                     00500000
                                                                        00510000
/*  initialize screen variables  */                                     00520000
If fsin Then Do                                                         00530000
    If ^Datatype(tube,'X') Then 'VMFCLEAR'      /*  clear if cons  */   00540000
    Call FSINIT tube            /*  figure out some screen attribs  */  00550000
    'PIPE REXXVARS | DROP | JOIN 1 /,/ | LOCATE /n FS./' ,              00560000
            '| CHANGE /n /GLOBALV SELECT GOPHER SETL / 1' ,             00570000
                    '| CHANGE /,v / / 1 | COMMAND'                      00580000
    End  /*  If  ..  Do  */                                             00590000
                                                                        00600000
/*  load client gems into memory for efficiency  */                     00610000
If load Then                                                            00620000
'PIPE CMS L GOPCLI* REXX * | SPEC /EXECLOAD / 1 1-* NEXT | COMMAND'     00630000
                                                                        00640000
Exit                                                                    00650000
                                                                        00660000
                                                                        00670000
                                                                        00680000
/* -------------------------------------------------------------- FSINIT00690000
 * Initialize variables used in building screen displays.               00700000
 * (this code comes from Chuck Boeheim's PIPEDEMO; Thanks, Chuck!)      00710000
 */                                                                     00720000
FSINIT:   Procedure Expose fs.                                          00730000
Parse Arg t                                                             00740000
fs.tube = t                                                             00750000
                                                                        00760000
If Datatype(fs.tube,'X') Then Do                                        00770000
                                                                        00780000
    /*----------------------------------------------------------------*/00790000
    /*  a dialed 3270 with pessimistic assumptions                    */00800000
    /*----------------------------------------------------------------*/00810000
                                                                        00820000
    fs.scrrows = 24                                                     00830000
    fs.scrcols = 80                                                     00840000
    fs.write  = '80'x                                                   00850000
    flags = '00'x                                                       00860000
                                                                        00870000
    End  /*  If  ..  Do  */                                             00880000
                                                                        00890000
Else Do                                                                 00900000
                                                                        00910000
    /*----------------------------------------------------------------*/00920000
    /*  Get the screen size from CP.                                  */00930000
    /*----------------------------------------------------------------*/00940000
                                                                        00950000
    Parse Value Diag('8C') with flags +1 3 fs.scrcols +2 fs.scrrows +2 .00960000
    fs.scrrows = c2d(fs.scrrows)                                        00970000
    fs.scrcols = c2d(fs.scrcols)                                        00980000
                                                                        00990000
    If  fs.scrrows > 24 | fs.scrcols > 80   Then fs.write = 'C0'x       01000000
                                            Else fs.write = '80'x       01010000
                                                                        01020000
    End  /*  Else  Do  */                                               01030000
                                                                        01040000
fs.operwa = 'C0'x       /* Erase/Write alternate      */                01050000
fs.operw  = '80'x       /* Erase/Write                */                01060000
fs.opwr   = '00'x       /* Write                      */                01070000
fs.oprd   = '06'x       /* Read modified.             */                01080000
                                                                        01090000
fs.wcc    = '03'x       /* Unlock keyboard, reset mdt */                01100000
                                                                        01110000
fs.high   = '1DE8'x     /* Protected, highlighted.    */                01120000
fs.low    = '1D60'x     /* Protected, normal.         */                01130000
fs.ic     = '13'x       /* Insert cursor.             */                01140000
                                                                        01150000
fs.color = (bitand(flags,'80'x) = '80'x)                                01160000
fs.exthi = (bitand(flags,'40'x) = '40'x)                                01170000
fs.pss   = (bitand(flags,'20'x) = '20'x)                                01180000
fs.7171  = (bitand(flags,'02'x) = '02'x)                                01190000
fs.14bit = (bitand(flags,'01'x) = '01'x)                                01200000
                                                                        01210000
Return                                                                  01220000
                                                                        01230000
                                                                        01240000
                                                                        01250000
/* -------------------------------------------------------------- UNLOAD01260000
 *  Unload Gopher EXECs, pipeline stages, messages to free-up memory.   01270000
 */                                                                     01280000
UNLOAD:                                                                 01290000
                                                                        01300000
'PIPE COMMAND EXECMAP | LOCATE 1.3 /GOP/' ,                             01310000
        '| SPEC /EXECDROP / 1 1.20 NEXT | COMMAND'                      01320000
If rc ^= 0 Then Exit rc                                                 01330000
                                                                        01340000
'SET LANGUAGE (DELETE GOP USER'                                         01350000
                                                                        01360000
If rc ^= 0 Then Exit rc                                                 01370000
                                                                        01380000
Exit                                                                    01390000
                                                                        01400000
:READ  GOPCLISX $REXX    A1 TMP200 01/25/93 15:25:42
/*                                                                      00010000
 *        Name: GOPCLISX REXX                                           00020000
 *              CMS Gopher client TCP/IP (sockets; "sox") function      00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23                                             00050000
 *                                                                      00060000
 *       Input: one or more gopher menu lines                           00070000
 *    Output 0: zero or more blocks of raw (may be ASCII) data          00080000
 *    Output 1: status messages and/or error messages                   00090000
 *                                                                      00100000
 *        Note: input is "plain text" (EBCDIC),  while output           00110000
 *              may be anything.   If output is "plain text" (ASCII),   00120000
 *              the following stage must handle translation.            00130000
 */                                                                     00140000
                                                                        00150000
/*                                                                      00160000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00170000
 *      with resources provided by Rice University and is intended      00180000
 *      to serve Rice's user community.   Rice has benefitted greatly   00190000
 *      from the free distribution of software,  therefore distribution 00200000
 *      of unmodified copies of this material is not restricted.        00210000
 *      You may change your own copy as needed.   Neither Rice          00220000
 *      University nor any of its employees or students shall be held   00230000
 *      liable for damages resulting from the use of this software.     00240000
 */                                                                     00250000
                                                                        00260000
Trace "OFF"                                                             00270000
                                                                        00280000
/*  sync with input so that 'CALLPIPE COMMAND' will work  */            00290000
'PEEKTO'                                                                00300000
                                                                        00310000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER GET GOPHER'                     00320000
If gopher = "" Then gopher = "Gopher"                                   00330000
quit = 0                                                                00340000
                                                                        00350000
Parse Arg . '(' opts ')' .                                              00360000
                                                                        00370000
trans = 0                                                               00380000
Do While opts ^= ""                                                     00390000
    Parse Var opts op opts                                              00400000
    Upper op                                                            00410000
    Select  /*  op  */                                                  00420000
        When Abbrev("TRANSLATE",op,4) Then trans = 1                    00430000
        When Abbrev("NOTRANSLATE",op,6) Then trans = 0                  00440000
        Otherwise Address "COMMAND" 'XMITMSG 3 OP (ERRMSG'              00450000
        End  /*  Select  op  */                                         00460000
    End  /*  Do  While  */                                              00470000
                                                                        00480000
If trans Then crlf = '0D25'x                                            00490000
         Else crlf = '0D0A'x                                            00500000
                                                                        00510000
/*                                                                      00520000
 *   Initialize RXSOCKET                                                00530000
 */                                                                     00540000
maxdesc = Socket('Initialize', gopher)                                  00550000
If maxdesc = "-1" Then Do                                               00560000
    If errno ^= "ESUBTASKALREADYACTIVE" Then Do                         00570000
    /*  Call STATUS tcperror()  */                                      00580000
        Exit -1                                                         00590000
        End  /*  If  ..  Do  */                                         00600000
    rc = Socket('Terminate')                                            00610000
    maxdesc = Socket('Initialize', gopher)                              00620000
    If maxdesc = "-1" Then Do                                           00630000
        Call STATUS tcperror()                                          00640000
        Exit -1                                                         00650000
        End  /*  If  ..  Do  */                                         00660000
    End  /*  If  ..  Do  */                                             00670000
                                                                        00680000
/*  L O O P  */                                                         00690000
                                                                        00700000
Do Forever                                                              00710000
                                                                        00720000
    'PEEKTO ITEM'                                                       00730000
    If rc ^= 0 Then Leave                                               00740000
                                                                        00750000
    Parse Var item 1 type 2 name '05'x path '05'x host ,                00760000
                                 '05'x port '05'x xtra                  00770000
    port = Strip(port)              /*  for robustness  */              00780000
    If type = '7' Then path = path || '05'x || xtra                     00790000
                                                                        00800000
    /*  Call STATUS "Connecting ... press ENTER twice to abort"  */     00810000
    /*  Call STATUS "Connecting to" host "port" port  */                00820000
    Call STATUS 22 '"' || host || '"' '"' || port || '"'                00830000
                                                                        00840000
    /*                                                                  00850000
     *   Request a new socket descriptor (TCP protocol)                 00860000
     */                                                                 00870000
    socket = Socket('Socket', 'AF_INET', 'Sock_Stream')                 00880000
    If socket = "-1" Then Do                                            00890000
        Call STATUS tcperror()                                          00900000
        Exit -1                                                         00910000
        End  /*  If  ..  Do  */                                         00920000
                                                                        00930000
    If trans Then Do                                                    00940000
        /*                                                              00950000
         *   Enable ASCII<->EBCDIC Translation Option                   00960000
         */                                                             00970000
        rc = Socket('SetSockOpt', socket, 'SOL_SOCKET', 'SO_EBCDIC', 1) 00980000
        If rc = "-1" Then Do                                            00990000
            Call STATUS tcperror()                                      01000000
            Exit -1                                                     01010000
            End  /*  If  ..  Do  */                                     01020000
        End  /*  If  ..  Do  */                                         01030000
                                                                        01040000
    /*                                                                  01050000
     *   Connect to the server                                          01060000
     */                                                                 01070000
    Parse Var host h1 '.' h2 '.' h3 '.' h4 '.' .                        01080000
    If  Datatype(h1,'N') &,                                             01090000
        Datatype(h2,'N') &,                                             01100000
        Datatype(h3,'N') &,                                             01110000
        Datatype(h4,'N')    Then                                        01120000
        hisaddr = d2c(h1) || d2c(h2) || d2c(h3) || d2c(h4)              01130000
    Else Do                                                             01140000
        hisaddr = Socket('GetHostByName', host)                         01150000
        If hisaddr = "-1" Then Do                                       01160000
        Call STATUS tcperror()                                          01170000
            Exit -1                                                     01180000
            End  /*  If  ..  Do  */                                     01190000
        End  /*  Else  Do  */                                           01200000
                                                                        01210000
    /*  Parse Var hisaddr h1 +1 h2 +1 h3 +1 h4 +1 .  */                 01220000
                                                                        01230000
    name = AF_INET || Htons(port) || hisaddr                            01240000
                                                                        01250000
    /*                                                                  01260000
     *   Set this socket to non-blocking mode                           01270000
     */                                                                 01280000
    rc = Socket('Ioctl', socket, 'FIONBIO', 1)                          01290000
    If rc="-1" Then Do                                                  01300000
        Call STATUS tcperror()                                          01310000
        Exit -1                                                         01320000
        End  /*  If  ..  Do  */                                         01330000
                                                                        01340000
    /*                                                                  01350000
     *   Connect to the host                                            01360000
     */                                                                 01370000
    rc = Socket('Connect', socket, name)                                01380000
    If rc = "-1" Then ,                                                 01390000
        If errno ^= "EINPROGRESS" Then Do                               01400000
            Call STATUS tcperror()                                      01410000
            If errno = "ECONNREFUSED" Then ,                            01420000
                Call STATUS 23 '"' || host || '"' '"' || port || '"'    01430000
        Exit -1                                                         01440000
        End  /*  If  ..  Do  */                                         01450000
                                                                        01460000
    rc = FD_ZERO('readmask')                                            01470000
    rc = FD_ZERO('writemask')                                           01480000
    rc = FD_SET(socket,'writemask')                                     01490000
    rc = FD_SET('0', 'readmask')                                        01500000
                                                                        01510000
    rc = Socket('Select', socket+1, 'readmask', 'writemask', 0, 20)     01520000
    If rc="-1" Then Do                                                  01530000
        Call STATUS tcperror()                                          01540000
        Exit -1                                                         01550000
        End  /*  If  ..  Do  */                                         01560000
                                                                        01570000
    If FD_ISSET('0', 'readmask')<>0 Then Do                             01580000
        rc = Socket('Close', socket)                                    01590000
        /*  Call STATUS "Connection canceled by user request"  */       01600000
        Call STATUS 28                                                  01610000
        Exit -1                                                         01620000
        End                                                             01630000
                                                                        01640000
    If FD_ISSET(socket, 'writemask')=0 Then Do                          01650000
        rc = Socket('Close', socket)                                    01660000
        /*  Call STATUS "Connection canceled by TIMEOUT"  */            01670000
        Call STATUS 29                                                  01680000
        Exit -1                                                         01690000
        end                                                             01700000
                                                                        01710000
    /* Return to standard mode                                          01720000
    rc = Socket('Ioctl', socket, 'FIONBIO', 0)                          01730000
     */                                                                 01740000
                                                                        01750000
    /*  TRANSlate option will affect both writing to,  as well as     * 01760000
     *  reading from,  the socket.   So if the socket is set for      * 01770000
     *  TRANSLATE,  then we need not translate the path from EBCDIC   * 01780000
     *  to ASCII.   But if not,  then we must do so as follows:       */01790000
    If ^trans Then                                                      01800000
    'CALLPIPE VAR PATH | TCPE2A' gopher '| VAR PATH'                    01810000
                                                                        01820000
    /*                                                                  01830000
     *   Send the "query" to the server                                 01840000
     */                                                                 01850000
    bytes_out = Socket('Write', socket, path || crlf)                   01860000
    If bytes_out = "-1" Then Do                                         01870000
        If errno = 'EPIPE' Then ,                                       01880000
            'OUTPUT' "ECONNREFUSED"                                     01890000
        If errno = 'EPIPE' Then ,                                       01900000
            Call STATUS 23 '"' || host || '"' '"' || port || '"'        01910000
        Else Call STATUS tcperror()                                     01920000
        Exit -1                                                         01930000
        End  /*  If  ..  Do  */                                         01940000
                                                                        01950000
    /*  Call STATUS "Reading ... press ENTER twice to abort"  */        01960000
    /*  Call STATUS "Reading ... "  */                                  01970000
    /*  Call STATUS 24  */                                              01980000
                                                                        01990000
    totbytes = 0                                                        02000000
prevtot = 0                                                             02010000
    /*                                                                  02020000
     *   Loop, reading response and sending to the next pipeline stage  02030000
     */                                                                 02040000
    Do Forever                                                          02050000
        /* Set up to trap console ENTER key */                          02060000
        rc = FD_ZERO('readmask')                                        02070000
        rc = FD_SET('0','readmask')                                     02080000
        rc = FD_SET(socket,'readmask')                                  02090000
                                                                        02100000
        /* Wait for something to happen */                              02110000
        rc = Socket('Select',socket+1,'readmask',0,0)                   02120000
        /* If console input, clear 'socket' and return */               02130000
        If FD_ISSET('0','readmask')<>0 Then Do                          02140000
            /*  Call STATUS "Request ABORTED"  */                       02150000
            Call STATUS 27                                              02160000
            rc = Socket('Close', socket)                                02170000
            Leave                                                       02180000
            End                                                         02190000
                                                                        02200000
        bytes_in = Socket('Read', socket, 'pack')                       02210000
        If bytes_in = "-1" Then                                         02220000
            Call STATUS tcperror()                                      02230000
        If bytes_in < 1 Then Leave                                      02240000
                                                                        02250000
        totbytes = totbytes + bytes_in                                  02260000
If prevtot/totbytes < 0.9 Then  /* adjust the 0.9 factor to taste */    02270000
Do                                                                      02280000
        Call STATUS 26 '"' || totbytes || '"'                           02290000
prevtot = totbytes                                                      02300000
End                                                                     02310000
        'OUTPUT' pack                                                   02320000
        If rc ^= 0 Then Leave                                           02330000
                                                                        02340000
        End  /*  Do  Forever  */                                        02350000
                                                                        02360000
    If rc ^= 0 Then Leave                                               02370000
                                                                        02380000
    /*                                                                  02390000
     *   All done, relinquish our socket descriptor                     02400000
     */                                                                 02410000
    rc = Socket('Close', socket)                                        02420000
    If rc = "-1" Then Do                                                02430000
        Call STATUS tcperror()                                          02440000
        Leave                                                           02450000
        End  /*  If  ..  Do  */                                         02460000
                                                                        02470000
    'READTO'                                                            02480000
                                                                        02490000
    End  /*  Do  Forever  */                                            02500000
                                                                        02510000
/*                                                                      02520000
 *   Tell RXSOCKET that we are done with this IUCV path                 02530000
 */                                                                     02540000
rc = Socket('Terminate')                                                02550000
If rc = "-1" Then Do                                                    02560000
    Call STATUS tcperror()                                              02570000
    Exit -1                                                             02580000
    End                                                                 02590000
                                                                        02600000
/*  an empty line as last in status stream indicates success  */        02610000
/*  Call STATUS " "  */                                                 02620000
                                                                        02630000
Exit                                                                    02640000
                                                                        02650000
                                                                        02660000
                                                                        02670000
/* -------------------------------------------------------------- STATUS02680000
 * Write  "status messages"  to the secondary stream,  if connected.    02690000
 * This routine saves & restores the current stream selection.          02700000
 * (though there are presently no other streams used besides 1 and 0)   02710000
 */                                                                     02720000
STATUS:   Procedure                                                     02730000
Parse Arg string                                                        02740000
                                                                        02750000
/* note the current stream (should be zero) */                          02760000
'STREAMNO OUTPUT'                                                       02770000
If rc < 0 Then Return                                                   02780000
stream = rc                                                             02790000
                                                                        02800000
/* select secondary stream and output the string */                     02810000
'SELECT OUTPUT 1'                                                       02820000
If rc ^= 0 Then Return                                                  02830000
If Datatype(Word(string,1),'N') Then                                    02840000
'CALLPIPE COMMAND XMITMSG' string '(APPLID GOP CALLER TCP ERRMSG | *:'  02850000
Else 'OUTPUT' string                                                    02860000
'SELECT OUTPUT' stream                                                  02870000
                                                                        02880000
Return                                                                  02890000
                                                                        02900000
:READ  GOPCLITM $REXX    A1 TMP200 01/25/93 15:25:39
/*                                                                      00010000
 *        Name: GOPCLITM REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client item processor          00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23                                             00050000
 *                                                                      00060000
 *       Input: one or more gopher menu lines                           00070000
 *      Output: zero or more information or error messages              00080000
 *              (EOF does not propagate back to input)                  00090000
 */                                                                     00100000
                                                                        00110000
/*                                                                      00120000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00130000
 *      with resources provided by Rice University and is intended      00140000
 *      to serve Rice's user community.   Rice has benefitted greatly   00150000
 *      from the free distribution of software,  therefore distribution 00160000
 *      of unmodified copies of this material is not restricted.        00170000
 *      You may change your own copy as needed.   Neither Rice          00180000
 *      University nor any of its employees or students shall be held   00190000
 *      liable for damages resulting from the use of this software.     00200000
 */                                                                     00210000
                                                                        00220000
Trace "OFF"                                                             00230000
                                                                        00240000
Parse Upper Arg disp . '(' . ')' .                                      00250000
If disp = "" Then disp = "OPEN"                                         00260000
/*  Say open  */                                                        00270000
                                                                        00280000
/*  sync with input so that 'CALLPIPE COMMAND' will work  */            00290000
'PEEKTO'                                                                00300000
                                                                        00310000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER GET GOPHER PROGID'              00320000
                                                                        00330000
/*  fetch fs. stem variable from GlobalVs  */                           00340000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,                  00350000
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'           00360000
If ^Datatype(fs.tube,'X') Then fs.tube = ""                             00370000
                                                                        00380000
/*  prepare for dynamic connection statistics  */                       00390000
stat = 'STEM STAT. | GOPCLIST'                                          00400000
                                                                        00410000
Do Forever                                                              00420000
                                                                        00430000
    'PEEKTO ITEM'                                                       00440000
    If rc ^= 0 Then Leave                                               00450000
                                                                        00460000
    'CALLPIPE COMMAND GLOBALV SELECT GOPHER PUT ITEM'                   00470000
                                                                        00480000
    Parse Var item name '05'x path '05'x host '05'x port '05'x xtra     00490000
    Parse Var name 1 type 2 name                                        00500000
                                                                        00510000
stat.0 = 0                                                              00520000
                                                                        00530000
    Select  /*  type  */                                                00540000
                                                                        00550000
        When  type = '0'  Then  Call  OPENFILE                          00560000
                                                                        00570000
        When  type = '1'  Then  Call  OPENMENU                          00580000
                                                                        00590000
        When  type = '2'  Then  Call  LOOKUP                            00600000
                                                                        00610000
        When  type = '4'  Then  Call  OPENFILE  /* MAC */               00620000
                                                                        00630000
        When  type = '5'  Then  Call  OPENFILE  /* DOS */               00640000
                                                                        00650000
        When  type = '6'  Then  Call  OPENFILE  /* UUE */               00660000
                                                                        00670000
        When  type = '7'  Then  Call  SEARCH                            00680000
                                                                        00690000
        When  type = '8'  Then  Call  TELNET                            00700000
                                                                        00710000
        When  type = '9'  Then  Call  BINARY                            00720000
                                                                        00730000
        When  type = 'T'  Then  Call  TN3270                            00740000
                                                                        00750000
        When  type = 'r'  | ,                                           00760000
              type = 'v'  Then  Call  CMSBLOCK                          00770000
                                                                        00780000
        When  type = 'I'  | ,                                           00790000
              type = ':'  | ,                                           00800000
              type = 'g'  Then  Call  GRAPHICS                          00810000
                                                                        00820000
        Otherwise               Call  OPENFILE                          00830000
                                                                        00840000
        End  /*  Select  type  */                                       00850000
                                                                        00860000
If rc ^= 0 Then 'CALLPIPE STEM STAT. | *:'                              00870000
                                                                        00880000
    'READTO'                                                            00890000
                                                                        00900000
    End  /*  Do  Forever  */                                            00910000
                                                                        00920000
Exit rc * (rc ^= 12)                                                    00930000
                                                                        00940000
                                                                        00950000
                                                                        00960000
/* ------------------------------------------------------------ OPENFILE00970000
 *  View or retrieve a plain text file.                                 00980000
 */                                                                     00990000
OPENFILE:                                                               01000000
                                                                        01010000
filter = 'GOPCLITX'                                                     01020000
                                                                        01030000
If disp = "KEEP" Then Signal KEEPFILE                                   01040000
                                                                        01050000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             01060000
    '| GOPCLITX | GOPCLIFV | *:' ,                                      01070000
    '! E: |' stat                                                       01080000
                                                                        01090000
Return                                                                  01100000
                                                                        01110000
                                                                        01120000
                                                                        01130000
/* ------------------------------------------------------------ OPENMENU01140000
 *  View or retrieve a plain text file.                                 01150000
 */                                                                     01160000
OPENMENU:                                                               01170000
                                                                        01180000
filter = 'GOPCLITX'                                                     01190000
                                                                        01200000
If disp = "KEEP" Then Signal KEEPFILE                                   01210000
                                                                        01220000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             01230000
    '| GOPCLITX | GOPCLIMB | *:' ,                                      01240000
    '! E: |' stat                                                       01250000
                                                                        01260000
Return                                                                  01270000
                                                                        01280000
                                                                        01290000
                                                                        01300000
/* -------------------------------------------------------------- LOOKUP01310000
 *  Perform user lookup.   (punt to PH EXEC or equivalent)              01320000
 */                                                                     01330000
LOOKUP:                                                                 01340000
                                                                        01350000
host = Strip(host)                                                      01360000
port = Strip(port)                                                      01370000
'CALLPIPE COMMAND GLOBALV SELECT PHCMS PUT HOST PORT'                   01380000
Address "CMS" 'PH'                                                      01390000
                                                                        01400000
Return                                                                  01410000
                                                                        01420000
                                                                        01430000
                                                                        01440000
/* -------------------------------------------------------------- SEARCH01450000
 */                                                                     01460000
SEARCH:                                                                 01470000
                                                                        01480000
'CALLPIPE COMMAND XMITMSG 601 (APPLID GOP NOHEADER' ,                   01490000
        '| GOPCLIUI | VAR KEYWORDS'                                     01500000
keywords = Strip(keywords)                                              01510000
If keywords = "" Then Return                                            01520000
                                                                        01530000
/*  prepend a  path<TAB>  to search string for WAIS servers  */         01540000
/*  path = path || '05'x || keywords  */                                01550000
item = item || '05'x || keywords                                        01560000
                                                                        01570000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             01580000
    '| GOPCLITX | GOPCLIMB | *:'                                        01590000
    '! E: |' stat                                                       01600000
                                                                        01610000
Return                                                                  01620000
                                                                        01630000
                                                                        01640000
                                                                        01650000
/* -------------------------------------------------------------- TELNET01660000
 */                                                                     01670000
TELNET:                                                                 01680000
                                                                        01690000
If fs.tube ^= "" Then Do                                                01700000
    /*  'OUTPUT' "Can't TELNET from this screen"  */                    01710000
    'CALLPIPE COMMAND XMITMSG 512 "TELNET"' ,                           01720000
            '(APPLID GOP CALLER CLI ERRMSG | *:'                        01730000
    Return                                                              01740000
    End /* If .. Do */                                                  01750000
                                                                        01760000
Address "COMMAND"                                                       01770000
                                                                        01780000
'VMFCLEAR'                                                              01790000
If port = 0 Then port = ""                                              01800000
/*  Say progid "TELNET" host port  */                                   01810000
'XMITMSG 30 HOST PORT (APPLID GOP CALLER CLI ERRMSG'                    01820000
/*  Say name  */                                                        01830000
'XMITMSG 7 NAME (APPLID GOP CALLER CLI ERRMSG NOCOMP'                   01840000
                                                                        01850000
If path ^= "" Then Do                                                   01860000
    /*  Say "login with:" path  */                                      01870000
    'XMITMSG 32 PATH (APPLID GOP CALLER CLI NOHEADER'                   01880000
    /*  Say "Press ENTER to continue ... "  */                          01890000
    'XMITMSG 33 (APPLID GOP CALLER CLI NOHEADER'                        01900000
    Parse External                                                      01910000
    End  /*  If  ..  Do  */                                             01920000
                                                                        01930000
'GLOBALV SELECT GOPHER GET TELNET'                                      01940000
If telnet = "" Then telnet = "TELNET"                                   01950000
Address "CMS" telnet host port                                          01960000
'VMFCLEAR'                                                              01970000
                                                                        01980000
Address                                                                 01990000
                                                                        02000000
Return                                                                  02010000
                                                                        02020000
                                                                        02030000
                                                                        02040000
/* -------------------------------------------------------------- BINARY02050000
 *  Load a "binary" (byte stream) file onto disk.                       02060000
 */                                                                     02070000
BINARY:                                                                 02080000
                                                                        02090000
filter = ""                                                             02100000
                                                                        02110000
If disp = "KEEP" Then Signal KEEPFILE                                   02120000
                                                                        02130000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             02140000
    '| GOPCLIFV | *:' ,                                                 02150000
    '! E: |' stat                                                       02160000
                                                                        02170000
Return                                                                  02180000
                                                                        02190000
                                                                        02200000
                                                                        02210000
/* -------------------------------------------------------------- TN327002220000
 *  This is almost exactly the same as the  TELNET  routine,            02230000
 *  but we let the user run a different program,  specified in          02240000
 *  global variable  TN3270,  if they wish.                             02250000
 */                                                                     02260000
TN3270:                                                                 02270000
                                                                        02280000
If fs.tube ^= "" Then Do                                                02290000
    /*  'OUTPUT' "Can't TN3270 from this screen"  */                    02300000
    'CALLPIPE COMMAND XMITMSG 512 "TN3270"' ,                           02310000
            '(APPLID GOP CALLER CLI ERRMSG | *:'                        02320000
    Return                                                              02330000
    End /* If .. Do */                                                  02340000
                                                                        02350000
Address "COMMAND"                                                       02360000
                                                                        02370000
'VMFCLEAR'                                                              02380000
If port = 0 Then port = ""                                              02390000
/*  Say progid "TN3270" host port  */                                   02400000
'XMITMSG 31 HOST PORT (APPLID GOP CALLER CLI ERRMSG'                    02410000
/*  Say name  */                                                        02420000
'XMITMSG 7 NAME (APPLID GOP CALLER CLI ERRMSG NOCOMP'                   02430000
If path ^= "" Then Do                                                   02440000
    /*  Say "login with:" path  */                                      02450000
    'XMITMSG 32 PATH (APPLID GOP CALLER CLI NOHEADER'                   02460000
    /*  Say "Press ENTER to continue ... "  */                          02470000
    'XMITMSG 33 (APPLID GOP CALLER CLI NOHEADER'                        02480000
    Parse External                                                      02490000
    End  /*  If  ..  Do  */                                             02500000
                                                                        02510000
'GLOBALV SELECT GOPHER GET TN3270'                                      02520000
If tn3270 = "" Then Do                                                  02530000
    'GLOBALV SELECT GOPHER GET TELNET'                                  02540000
    If telnet = "" Then telnet = "TELNET"                               02550000
    tn3270 = telnet                                                     02560000
    End  /*  If  ..  Do  */                                             02570000
Address "CMS" tn3270 host port                                          02580000
'VMFCLEAR'                                                              02590000
                                                                        02600000
Address                                                                 02610000
                                                                        02620000
Return                                                                  02630000
                                                                        02640000
                                                                        02650000
                                                                        02660000
/* ------------------------------------------------------------ CMSBLOCK02670000
 *  Save a record oriented file (type 'r' or type 'v') onto disk.       02680000
 */                                                                     02690000
CMSBLOCK:                                                               02700000
                                                                        02710000
filter = 'DEBLOCK CMS'                                                  02720000
                                                                        02730000
If disp = "KEEP" Then Signal KEEPFILE                                   02740000
                                                                        02750000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             02760000
    '| DEBLOCK CMS | GOPCLIFV | *:' ,                                   02770000
    '! E: |' stat                                                       02780000
                                                                        02790000
Return                                                                  02800000
                                                                        02810000
                                                                        02820000
                                                                        02830000
/* ------------------------------------------------------------ GRAPHICS02840000
 *  Display or save a graphics (type 'I') file.                         02850000
 */                                                                     02860000
GRAPHICS:                                                               02870000
                                                                        02880000
filter = ""     /*  same as for  "binary"  files  */                    02890000
                                                                        02900000
If disp = "KEEP" Then Signal KEEPFILE                                   02910000
                                                                        02920000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             02930000
        '| GOPCLIGV | *: ! E: |' stat                                   02940000
                                                                        02950000
Return                                                                  02960000
                                                                        02970000
                                                                        02980000
                                                                        02990000
/* ------------------------------------------------------------ KEEPFILE03000000
 *  Save the selected file on disk.                                     03010000
 */                                                                     03020000
KEEPFILE:                                                               03030000
                                                                        03040000
If fs.tube ^= "" Then Do                                                03050000
    'CALLPIPE COMMAND XMITMSG 508 (APPLID GOP CALLER CLI ERRMSG | *:'   03060000
    Return                                                              03070000
    End  /*  If  ..  Do  */                                             03080000
                                                                        03090000
Parse Var path 1 . 2 path    /*  discard type indicator  */             03100000
file = gopclifi(path)                                                   03110000
'CALLPIPE CMS STATE' file 'A | VAR NOTFOUND'                            03120000
If rc ^= 0 & rc ^= 28 Then 'CALLPIPE VAR NOTFOUND | *:'                 03130000
If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 594 FILE' ,                    03140000
        '(APPLID GOP CALLER CLI ERRMSG | *:'                            03150000
If rc ^= 28 Then Return                                                 03160000
                                                                        03170000
If filter = "" Then                                                     03180000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             03190000
        '| >' file 'A' ,                                                03200000
        '! E: |' stat                                                   03210000
Else                                                                    03220000
'CALLPIPE (END !) VAR ITEM | E: GOPCLISX' ,                             03230000
        '|' filter '| >' file 'A' ,                                     03240000
        '! E: |' stat                                                   03250000
                                                                        03260000
If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 571 FILE PATH' ,               03270000
        '(APPLID GOP CALLER CLI ERRMSG | *:'                            03280000
/*  If rc = 0 Then errmsg = "Created" fn ft fm "from" path  */          03290000
                                                                        03300000
Return                                                                  03310000
                                                                        03320000
:READ  GOPCLIST $REXX    A1 TMP200 01/25/93 15:25:37
/*                                                                      00010000
 *        Name: GOPCLIST REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client transaction status      00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1993-Jan-12                                             00050000
 *                                                                      00060000
 *       Input: zero or more connection status messages                 00070000
 *      Output: -none-                                                  00080000
 */                                                                     00090000
                                                                        00100000
/*                                                                      00110000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00120000
 *      with resources provided by Rice University and is intended      00130000
 *      to serve Rice's user community.   Rice has benefitted greatly   00140000
 *      from the free distribution of software,  therefore distribution 00150000
 *      of unmodified copies of this material is not restricted.        00160000
 *      You may change your own copy as needed.   Neither Rice          00170000
 *      University nor any of its employees or students shall be held   00180000
 *      liable for damages resulting from the use of this software.     00190000
 */                                                                     00200000
                                                                        00210000
Trace "OFF"                                                             00220000
                                                                        00230000
/*  sync with input  */                                                 00240000
'PEEKTO'                                                                00250000
If rc ^= 0 Then Exit rc * (rc ^= 12)                                    00260000
                                                                        00270000
/*  abort if we're not in a 370 mode machine  */                        00280000
Parse Value Diag(08,'QUERY SET') With . "MACHINE" mach . ',' . '15'x .  00290000
If mach ^= "370" & mach ^= "" Then Do                                   00300000
    'CALLPIPE *: | HOLE'                                                00310000
    Exit rc                                                             00320000
    End  /*  If  ..  Do  */                                             00330000
                                                                        00340000
/*  fetch fs. stem variable from GlobalVs  */                           00350000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,                  00360000
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'           00370000
If ^Datatype(fs.tube,'X') Then fs.tube = ""                             00380000
                                                                        00390000
/*  prepare for dynamic connection statistics  */                       00400000
_wid = fs.scrcols - 2                                                   00410000
_sba = c2x(sba(1,-1) || '1D60'x)                                        00420000
                                                                        00430000
'CALLPIPE *: | CHOP ' _wid '| PAD' _wid ,                               00440000
       '| SPEC /00C3' || _sba || '/ X2C 1 1-* NEXT' ,                   00450000
       '| FULLSCR' fs.tube 'NOREAD | HOLE'                              00460000
                                                                        00470000
Exit rc                                                                 00480000
                                                                        00490000
                                                                        00500000
                                                                        00510000
/* ----------------------------------------------------------------- SBA00520000
 *  (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)     00530000
 *  Construct Set Buffer Address order from row and column.             00540000
 */                                                                     00550000
                                                                        00560000
SBA:      Procedure Expose fs.                                          00570000
                                                                        00580000
arg row , col, .                                                        00590000
row = Trunc(row)                                                        00600000
col = Trunc(col)                                                        00610000
                                                                        00620000
/*-----------------------------------------------------------------*/   00630000
/* Calculate binary address.                                       */   00640000
/*-----------------------------------------------------------------*/   00650000
                                                                        00660000
offset = row * fs.scrcols + col                                         00670000
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End     00680000
                                                                        00690000
if fs.14bit then return '11'x || d2c(offset,2)                          00700000
                                                                        00710000
/*-----------------------------------------------------------------*/   00720000
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/   00730000
/*-----------------------------------------------------------------*/   00740000
                                                                        00750000
'CALLPIPE var offset'               ,   /* Start with char number.    */00760000
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */00770000
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */00780000
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */00790000
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */00800000
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */00810000
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */00820000
                '01-09 C1-C9'       ,   /*   buffer address.          */00830000
                '11-19 D1-D9'       ,   /*                            */00840000
                '22-29 E2-E9'       ,   /*                            */00850000
                '30-39 F0-F9'       ,   /*                            */00860000
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */00870000
    '| var offset'                      /* Put back in variable.      */00880000
                                                                        00890000
Return offset                                                           00900000
                                                                        00910000
:READ  GOPCLIMB $REXX    A1 TMP200 01/25/93 15:25:33
/*                                                                      00010000
 *        Name: GOPCLIMB REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client menu browser            00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23                                             00050000
 *                                                                      00060000
 *       Input: one or more gopher menu lines                           00070000
 *      Output: zero or more information or error messages              00080000
 */                                                                     00090000
                                                                        00100000
/*                                                                      00110000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00120000
 *      with resources provided by Rice University and is intended      00130000
 *      to serve Rice's user community.   Rice has benefitted greatly   00140000
 *      from the free distribution of software,  therefore distribution 00150000
 *      of unmodified copies of this material is not restricted.        00160000
 *      You may change your own copy as needed.   Neither Rice          00170000
 *      University nor any of its employees or students shall be held   00180000
 *      liable for damages resulting from the use of this software.     00190000
 */                                                                     00200000
                                                                        00210000
Trace "OFF"                                                             00220000
                                                                        00230000
Parse Arg args '(' . ')' .                                              00240000
                                                                        00250000
/*  verify availability of input  */                                    00260000
'PEEKTO'                                                                00270000
If rc ^= 0 & rc ^= 12 Then Exit rc                                      00280000
If rc = 12 Then Do  /*  empty menu  */                                  00290000
    'CALLPIPE COMMAND XMITMSG 60 (APPLID GOP CALLER CLI ERRMSG | *:'    00300000
    Exit                                                                00310000
    End  /*  If  ..  Do  */                                             00320000
                                                                        00330000
Address "COMMAND" 'GLOBALV SELECT GOPHER GET' ,                         00340000
        'GOPHER PROGID VIEWER ITEM'                                     00350000
quit = 0                                                                00360000
                                                                        00370000
Parse Var item name '05'x path '05'x host '05'x port '05'x xtra         00380000
Parse Var name 1 . 2 name       /*  discard type indicator byte  */     00390000
Parse Var path 1 . 2 path       /*  discard type indicator byte  */     00400000
If name = "" Then name = args                                           00410000
booklist = (item = "")                                                  00420000
                                                                        00430000
/*  fetch fs. stem variable from GlobalVs  */                           00440000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,                  00450000
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'           00460000
If ^Datatype(fs.tube,'X') Then fs.tube = ""                             00470000
                                                                        00480000
'CALLPIPE *: | STEM MENU.'                                              00490000
                                                                        00500000
/* is it a server error? */                                             00510000
If menu.0 = 1 & Left(menu.1,1) = '-' Then Do                            00520000
    Parse Var menu.1 . '-' errmsg '05'x .                               00530000
    'OUTPUT' errmsg                                                     00540000
    Exit                                                                00550000
    End  /*  If  ..  Do  */                                             00560000
                                                                        00570000
/*  display the menu and process user's response  */                    00580000
row = 0;        col = 0         /*  reset later  */                     00590000
ki = menu.0;    kl = fs.scrrows - 5;    ko = 1                          00600000
needle = ""     /*  may be re-used within this context  */              00610000
message.0 = 0                                                           00620000
command = ""                                                            00630000
                                                                        00640000
If booklist Then 'CALLPIPE COMMAND XMITMSG 615' ,                       00650000
        '(APPLID GOP CALLER CLI NOCOMP | SPEC WORD 2-* 1 | STEM HELP.'  00660000
            Else 'CALLPIPE COMMAND XMITMSG 613' ,                       00670000
        '(APPLID GOP CALLER CLI NOCOMP | SPEC WORD 2-* 1 | STEM HELP.'  00680000
                                                                        00690000
'CALLPIPE COMMAND XMITMSG 5 (APPLID GOP NOHEADER | VAR MORE'            00700000
                                                                        00710000
Do Forever                                                              00720000
                                                                        00730000
    /*  write the program title line  */                                00740000
    wscreen = sba(0,-1) || field("BLUE","PROT") || sba(0,0) || progid , 00750000
                        || sba(0,fs.scrcols-Length(host)-1) || host     00760000
                                                                        00770000
    /*  no SBA for status because it follows host immediately  */       00780000
    If message.0 < 1 Then Do                                            00790000
    wscreen = wscreen   || field("PROT") || Left(ko || '/' || ki, 11)   00800000
    If ko + kl <= ki Then                                               00810000
    wscreen = wscreen   || field("WHITE","HIGH","PROT") || more         00820000
        End  /*  If  ..  Do  */                                         00830000
                                                                        00840000
    /*  don't write status or name if they'll be overlaid  */           00850000
    If message.0 < 2 Then                                               00860000
    wscreen = wscreen   || sba(2,(fs.scrcols-Length(name))/2) ,         00870000
                        || field("WHITE","PROT") || name                00880000
                                                                        00890000
    /*  write as many message lines as needed  */                       00900000
    If message.0 > 0 Then Do                                            00910000
        Do i = 1 to message.0                                           00920000
            wscreen = wscreen || sba(i,-1) ,                            00930000
                || field("RED","HIGH","PROT") || message.i              00940000
            End  /*  Do  For  */                                        00950000
        message.0 = 0                                                   00960000
        End  /*  If  ..  Do  */                                         00970000
    /*  we should probably limit that count  */                         00980000
                                                                        00990000
    /*  write those PFkey settings  */                                  01000000
    wscreen = wscreen   || sba(fs.scrrows-2,-1) ,                       01010000
                        || field("BLUE","PROT") ,                       01020000
                        || help.1 ,                                     01030000
                        || sba(fs.scrrows-1,-1) ,                       01040000
                        || field("BLUE","PROT") ,                       01050000
                        || help.2                                       01060000
                                                                        01070000
    i = 1; j = ko                                                       01080000
    Do While i <= kl & j <= ki                                          01090000
                                                                        01100000
        Parse Var menu.j _name '05'x .                                  01110000
        Parse Var _name 1 _type 2 _name                                 01120000
        'CALLPIPE VAR _NAME | XLATE OUTPUT' ,                           01130000
            '| XLATE *-* 00-3F 40 FF 40 | VAR _NAME'                    01140000
                                                                        01150000
        wscreen = wscreen || sba(i+2,-1) ,                              01160000
                          || field("BLUE","PROT","HIGH")                01170000
        If _type = 'i' Then                                             01180000
        wscreen = wscreen || Left(_name,fs.scrcols-1)                   01190000
                      Else Do                                           01200000
        wscreen = wscreen || Left(gtag(_type),11) ,                     01210000
                          || field("GREEN") ,                           01220000
                          || Left(_name,fs.scrcols-13)                  01230000
            If row = 0 Then Do                                          01240000
                row = i + 2;    col = 12                                01250000
                End  /*  If  ..  Do  */                                 01260000
            End  /*  Else  Do  */                                       01270000
                                                                        01280000
        i = i + 1;  j = j + 1                                           01290000
                                                                        01300000
        End  /*  Do  While  */                                          01310000
                                                                        01320000
    rscreen = write_read(wscreen || sba(row,col) || '13'x)              01330000
    Parse Var rscreen 1 aid 2 offset . '11'x rscreen                    01340000
    offset = fix(offset)                                                01350000
    row = offset % fs.scrcols; col = offset // fs.scrcols               01360000
                                                                        01370000
    /*  keep the row/col values within bounds  */                       01380000
    If  row      <   3       Then row = 3                               01390000
    If  row      >   kl + 3  Then row = kl + 3                          01400000
    If  row + ko >   ki + 3  Then row = ki + 3 - ko                     01410000
    col = 12    /*  just reset it  */                                   01420000
                                                                        01430000
    i = row + ko - 3                                                    01440000
                                                                        01450000
    Select /* aid */                                                    01460000
        When  aid = '7D'x   /* enter */ | ,                             01470000
              aid = 'F2'x   /*  PF2  */ | ,                             01480000
              aid = 'C2'x   /*  PF14 */ | ,                             01490000
              aid = '7B'x   /*  PF11 */ | ,                             01500000
              aid = '4B'x   /*  PF23 */ Then  Call  OPEN                01510000
        When  aid = 'F3'x   /*  PF3  */ | ,                             01520000
              aid = 'C3'x   /*  PF15 */ Then  Leave                     01530000
        When  aid = 'F4'x   /*  PF4  */ | ,                             01540000
              aid = 'C4'x   /*  PF16 */ Then  Call  PRINT               01550000
        When  aid = 'F5'x   /*  PF5  */ | ,                             01560000
              aid = 'C5'x   /*  PF17 */ Then  Call  KEEP                01570000
        When  aid = 'F6'x   /*  PF6  */ | ,                             01580000
              aid = 'C6'x   /*  PF18 */ Then  Call  FIND                01590000
        When  aid = 'F7'x   /*  PF7  */ | ,                             01600000
              aid = 'C7'x   /*  PF19 */ Then Do                         01610000
            ko = Max(ko-kl+1,1)                                         01620000
            row = 3                                                     01630000
            End  /*  When  ..  Do  */                                   01640000
        When  aid = 'F8'x   /*  PF8  */ | ,                             01650000
              aid = 'C8'x   /*  PF20 */ Then Do                         01660000
            ko = Min(ko+kl-1,ki)                                        01670000
            row = 3                                                     01680000
            End  /*  When  ..  Do  */                                   01690000
        When  aid = 'F9'x   /*  PF9  */ | ,                             01700000
              aid = 'C9'x   /*  PF21 */ Then  Call  MARK                01710000
        When  aid = '7A'x   /*  PF10 */ | ,                             01720000
              aid = '4A'x   /*  PF22 */ Then  Call  BOOKLIST            01730000
        When  aid = '6D'x   /* clear */ | ,                             01740000
              aid = '6E'x   /*  PA2  */ Then Do                         01750000
            row = 3;    col = 12;   ko = 1                              01760000
            End  /*  When ..  Do  */                                    01770000
        When  aid = '7C'x   /*  PF12 */ | ,                             01780000
              aid = '4C'x   /*  PF24 */ | ,                             01790000
              aid = 'F0'x   /* sysrq */ | ,                             01800000
              aid = '6C'x   /*  PA1  */ Then  quit = 1                  01810000
        When  aid = 'F1'x   /*  PF1  */ | ,                             01820000
              aid = 'C1'x   /*  PF13 */ Then  Call  HELP                01830000
        When  aid = '00'x               Then Do                         01840000
            /*  I/O error on screen  */                                 01850000
            'CALLPIPE COMMAND XMITMSG 925 (APPLID GOP' ,                01860000
                    'CALLER CLI ERRMSG | STEM MESSAGE. APPEND'          01870000
            Leave                                                       01880000
            End                                                         01890000
        Otherwise  Do   /*  Undefined PFkey/PAkey  */                   01900000
            'CALLPIPE COMMAND XMITMSG 657 "' || c2x(aid) || '"' ,       01910000
                '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'  01920000
            End  /*  Otherwise  Do  */                                  01930000
        End  /*  Select  aid  */                                        01940000
                                                                        01950000
    Address "COMMAND" 'GLOBALV SELECT GOPHER GET COMMAND'               01960000
    Parse Upper Var command cmdverb .                                   01970000
    quit = (quit | Abbrev("QUIT",cmdverb,1))                            01980000
                                                                        01990000
    If quit Then Leave                                                  02000000
                                                                        02010000
    End  /*  Do  Forever  */                                            02020000
                                                                        02030000
If quit Then command = "QUIT"                                           02040000
                                                                        02050000
'CALLPIPE STEM MESSAGE. | *:'                                           02060000
                                                                        02070000
Parse Upper Var command cmdverb .                                       02080000
Address "COMMAND" 'GLOBALV SELECT GOPHER PUT' ,                         02090000
        'COMMAND CMDVERB'                                               02100000
                                                                        02110000
Exit                                                                    02120000
                                                                        02130000
                                                                        02140000
                                                                        02150000
/* ---------------------------------------------------------------- OPEN02160000
 */                                                                     02170000
OPEN:                                                                   02180000
                                                                        02190000
'CALLPIPE VAR MENU.' || i '| GOPCLITM OPEN | STEM MESSAGE. APPEND'      02200000
                                                                        02210000
Return                                                                  02220000
                                                                        02230000
                                                                        02240000
                                                                        02250000
/* --------------------------------------------------------------- PRINT02260000
 * Print the current "menu" on the user's virtual printer.              02270000
 */                                                                     02280000
PRINT:                                                                  02290000
                                                                        02300000
If fs.tube ^= "" Then Do                                                02310000
    /*  "Can't PRINT from this terminal."  */                           02320000
    'CALLPIPE COMMAND XMITMSG 507 (APPLID GOP CALLER CLI ERRMSG' ,      02330000
            '| STEM MESSAGE. APPEND'                                    02340000
    Return                                                              02350000
    End /* If .. Do */                                                  02360000
                                                                        02370000
'CALLPIPE STEM MENU. | XLATE *-* 05 7A' ,                               02380000
        '| PRINT (TITLE' name '| STEM MESSAGE. APPEND'                  02390000
                                                                        02400000
Return                                                                  02410000
                                                                        02420000
                                                                        02430000
                                                                        02440000
/* ---------------------------------------------------------------- KEEP02450000
 */                                                                     02460000
KEEP:                                                                   02470000
                                                                        02480000
'CALLPIPE VAR MENU.' || i '| GOPCLITM KEEP | STEM MESSAGE. APPEND'      02490000
                                                                        02500000
Return                                                                  02510000
                                                                        02520000
                                                                        02530000
                                                                        02540000
/* ---------------------------------------------------------------- FIND02550000
 *  Find a particular string within the menu being viewed.              02560000
 *  Call GOPCLIUI for user input with prompt.                           02570000
 */                                                                     02580000
FIND:                                                                   02590000
                                                                        02600000
'CALLPIPE COMMAND XMITMSG 602 "' || needle || '" (APPLID GOP' ,         02610000
        'CALLER CLI NOHEADER | GOPCLIUI | VAR NEEDLE'                   02620000
needle = Translate(Strip(needle))                                       02630000
If needle = "" Then Return                                              02640000
                                                                        02650000
Do i = ko + 1 to ki                                                     02660000
    If Index(Translate(menu.i),needle) > 0 Then Do                      02670000
        ko = i                                                          02680000
        Return                                                          02690000
        End  /*  If  ..  Do  */                                         02700000
    End  /*  Do  For  */                                                02710000
                                                                        02720000
/*  'CALLPIPE COMMAND XMITMSG 546 (ERRMSG'  CALLER DMS is OK  */        02730000
/*  "Target not found"  */                                              02740000
'CALLPIPE COMMAND XMITMSG 546 (APPLID GOP CALLER CLI ERRMSG' ,          02750000
        '| STEM MESSAGE. APPEND'                                        02760000
                                                                        02770000
Return                                                                  02780000
                                                                        02790000
                                                                        02800000
                                                                        02810000
/* ---------------------------------------------------------------- MARK02820000
 *  Save a bookmark referencing this menu,                              02830000
 *  or  (if in "booklist" mode)  delete the bookmark at the cursor.     02840000
 */                                                                     02850000
MARK:                                                                   02860000
                                                                        02870000
If fs.tube ^= "" Then Do                                                02880000
    /*  "Can't set bookmarks from this screen."  */                     02890000
    'CALLPIPE COMMAND XMITMSG 43 (APPLID GOP CALLER CLI ERRMSG' ,       02900000
            '| STEM MESSAGE. APPEND'                                    02910000
    Return                                                              02920000
    End /* If .. Do */                                                  02930000
                                                                        02940000
If booklist Then Do                                                     02950000
    'CALLPIPE COMMAND XMITMSG 42 I (APPLID GOP NOHEADER' ,              02960000
        '| SPEC /i            / 1 1-* NEXT | VAR BOOKMARK.' || i        02970000
    If rc = 0 Then                                                      02980000
    Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i       02990000
    If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 42 I' ,                    03000000
        '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'          03010000
        /*  "Bookmark" i "deleted."  */                                 03020000
    Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,                  03030000
        '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'          03040000
    Return                                                              03050000
    End /* If .. Do */                                                  03060000
                                                                        03070000
Address "COMMAND" 'GLOBALV SELECT GOPHER GET BOOKMARK.0'                03080000
If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0                        03090000
i = bookmark.0 + 1                                                      03100000
bookmark.i = item                                                       03110000
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i           03120000
bookmark.0 = i                                                          03130000
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'               03140000
                                                                        03150000
If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 41 I' ,                        03160000
    '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'              03170000
    /*  "Bookmark" i "saved."  */                                       03180000
          Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,            03190000
        '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'          03200000
                                                                        03210000
Return                                                                  03220000
                                                                        03230000
                                                                        03240000
                                                                        03250000
/* ------------------------------------------------------------ BOOKLIST03260000
 *  Call GOPCLI to show the lit of bookmarks.                           03270000
 */                                                                     03280000
BOOKLIST:                                                               03290000
                                                                        03300000
Address "CMS" 'GOPCLI (BOOKLIST'                                        03310000
                                                                        03320000
Return                                                                  03330000
                                                                        03340000
                                                                        03350000
                                                                        03360000
/* ----------------------------------------------------------------- FIX03370000
 * Takes an inbound 3270 DS screen address (two bytes)                  03380000
 * and returns the equivalent byte offset in decimal.                   03390000
 */                                                                     03400000
FIX:                                                                    03410000
Parse Arg o,.                                                           03420000
Parse Var o 1 o1 2 o2 3 .                                               03430000
o1 = c2d(o1)                                                            03440000
o2 = c2d(o2)                                                            03450000
If o1 < 64 Then Return o1 * 256 + o2                                    03460000
           Else Return (o1 // 64) * 64 + (o2 // 64)                     03470000
                                                                        03480000
                                                                        03490000
                                                                        03500000
/* ---------------------------------------------------------- WRITE_READ03510000
 * Display what we have, then wait for user input and return it.        03520000
 */                                                                     03530000
WRITE_READ: Procedure Expose fs.                                        03540000
Parse Arg ws,wcc,wrt,.                                                  03550000
If wcc = "" Then wcc = 'C3'x                                            03560000
/*  If wrt = "" Then wrt = 'C0'x  */                                    03570000
If wrt = "" Then wrt = fs.write                                         03580000
ws = wrt || wcc || ws                                                   03590000
'CALLPIPE VAR WS | FULLSCR' fs.tube '| VAR RS'                          03600000
If rc ^= 0 Then rs = '000000'x                                          03610000
Return rs                                                               03620000
                                                                        03630000
                                                                        03640000
                                                                        03650000
/* ----------------------------------------------------------------- SBA03660000
 * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)      03670000
 * Construct Set Buffer Address order from row and column.              03680000
 */                                                                     03690000
                                                                        03700000
SBA:      Procedure Expose fs.                                          03710000
                                                                        03720000
arg row , col, .                                                        03730000
row = Trunc(row)                                                        03740000
col = Trunc(col)                                                        03750000
                                                                        03760000
/*-----------------------------------------------------------------*/   03770000
/* Calculate binary address.                                       */   03780000
/*-----------------------------------------------------------------*/   03790000
                                                                        03800000
offset = row * fs.scrcols + col                                         03810000
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End     03820000
                                                                        03830000
if fs.14bit then return '11'x || d2c(offset,2)                          03840000
                                                                        03850000
/*-----------------------------------------------------------------*/   03860000
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/   03870000
/*-----------------------------------------------------------------*/   03880000
                                                                        03890000
'CALLPIPE var offset'               ,   /* Start with char number.    */03900000
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */03910000
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */03920000
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */03930000
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */03940000
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */03950000
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */03960000
                '01-09 C1-C9'       ,   /*   buffer address.          */03970000
                '11-19 D1-D9'       ,   /*                            */03980000
                '22-29 E2-E9'       ,   /*                            */03990000
                '30-39 F0-F9'       ,   /*                            */04000000
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */04010000
    '| var offset'                      /* Put back in variable.      */04020000
                                                                        04030000
Return offset                                                           04040000
                                                                        04050000
                                                                        04060000
                                                                        04070000
/* --------------------------------------------------------------- FIELD04080000
 * Generate the 3270 DS sequence for extended field attributes          04090000
 * (if available).                                                      04100000
 */                                                                     04110000
FIELD:    Procedure Expose fs.                                          04120000
a = '00'x                                                               04130000
b = '00'x                                                               04140000
c = 'F1'x                                                               04150000
i = 1                                                                   04160000
Do While Arg(i) ^= ""                                                   04170000
    Select  /*  at  */                                                  04180000
        When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)     04190000
        When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)     04200000
        When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)     04210000
        When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)     04220000
        When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)     04230000
        When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)     04240000
        When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)     04250000
        When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x              04260000
        When Abbrev("RED",Arg(i),3)         Then c = 'F2'x              04270000
        When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x              04280000
        When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x              04290000
        When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x              04300000
        When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x              04310000
        When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x              04320000
        Otherwise nop                                                   04330000
        End  /*  Select  at  */                                         04340000
    i = i + 1                                                           04350000
    End  /*  Do  While  */                                              04360000
                                                                        04370000
If  ^fs.color   | ,                                                     04380000
    ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)                  04390000
                Else    Return '2902'x || ,                             04400000
                               'C0'x   || bitor(a,'40'x) || ,           04410000
                               '42'x   || bitor(c,'40'x)                04420000
                                                                        04430000
                                                                        04440000
                                                                        04450000
/* ---------------------------------------------------------------- GTAG04460000
 *  Match the gopher data type to a national language  "tag"  string.   04470000
 */                                                                     04480000
GTAG:     Procedure                                                     04490000
                                                                        04500000
Parse Arg type                                                          04510000
                                                                        04520000
    Select  /*  type  */                                                04530000
                                                                        04540000
        When type = '0' Then _tag = 700                                 04550000
        When type = '1' Then _tag = 701                                 04560000
        When type = '2' Then _tag = 702                                 04570000
        When type = '3' Then _tag = 703                                 04580000
        When type = '4' Then _tag = 704                                 04590000
        When type = '5' Then _tag = 705                                 04600000
        When type = '6' Then _tag = 706                                 04610000
        When type = '7' Then _tag = 707                                 04620000
        When type = '8' Then _tag = 708                                 04630000
        When type = '9' Then _tag = 709                                 04640000
        When type = 's' Then _tag = 767                                 04650000
        When type = 'r' Then _tag = 766                                 04660000
        When type = 'v' Then _tag = 770                                 04670000
        When type = 'i' Then _tag = 757                                 04680000
        When type = 'I' Then _tag = 725                                 04690000
        When type = 'g' Then _tag = 755                                 04700000
        When type = 'M' Then _tag = 729                                 04710000
        When type = 'T' Then _tag = 736                                 04720000
                                                                        04730000
        When type = ':' Then _tag = 710                                 04740000
        When type = ';' Then _tag = 711                                 04750000
        When type = '<' Then _tag = 712                                 04760000
                                                                        04770000
        Otherwise            _tag = 908                                 04780000
                                                                        04790000
        End  /*  Select  type  */                                       04800000
                                                                        04810000
'CALLPIPE COMMAND XMITMSG' _tag 'TYPE (APPLID GOP NOHEADER | VAR TAG'   04820000
                                                                        04830000
Return tag                                                              04840000
                                                                        04850000
                                                                        04860000
                                                                        04870000
/* ---------------------------------------------------------------- HELP04880000
 *  Invoke CMS HELP for GOPHER BROWSER (the menu browser).              04890000
 */                                                                     04900000
HELP:     Procedure Expose fs. message.                                 04910000
                                                                        04920000
If fs.tube ^= "" Then                                                   04930000
    'CALLPIPE COMMAND HELP GOPHER BROWSER (ALL NOSCREEN' ,              04940000
        '| GOPCLIFV BROWSER HELP' ,                                     04950000
            '| STEM MESSAGE. APPEND'                                    04960000
                                                                        04970000
Else Do                                                                 04980000
    Address "COMMAND" 'HELP GOPHER BROWSER'                             04990000
    Address "COMMAND" 'VMFCLEAR'                                        05000000
    End  /*  Else  Do  */                                               05010000
                                                                        05020000
Return                                                                  05030000
                                                                        05040000
:READ  GOPCLIUI $REXX    A1 TMP200 01/25/93 15:25:29
/*                                                                      00010000
 *        Name: GOPCLIUI REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client user input              00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23                                             00050000
 *                                                                      00060000
 *       Input: a prompt string                                         00070000
 *      Output: the user's response                                     00080000
 *                                                                      00090000
 *              Untested with multiples,  but should work that way.     00100000
 */                                                                     00110000
                                                                        00120000
/*                                                                      00130000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00140000
 *      with resources provided by Rice University and is intended      00150000
 *      to serve Rice's user community.   Rice has benefitted greatly   00160000
 *      from the free distribution of software,  therefore distribution 00170000
 *      of unmodified copies of this material is not restricted.        00180000
 *      You may change your own copy as needed.   Neither Rice          00190000
 *      University nor any of its employees or students shall be held   00200000
 *      liable for damages resulting from the use of this software.     00210000
 */                                                                     00220000
                                                                        00230000
Trace "OFF"                                                             00240000
                                                                        00250000
/*  fetch fs. stem variable from calling REXX environment  */           00260000
'CALLPIPE REXXVARS 1 | DROP | JOIN 1 /,/' ,                             00270000
        '| CHANGE /n /,/ | CHANGE /,v /,/ 1 | LOCATE /FS./ | VARLOAD'   00280000
                                                                        00290000
/*  trouble with plain write,  so fetch current screen contents  */     00300000
'CALLPIPE LITERAL 00 | SPEC 1-2 X2C 1' ,                                00310000
        '| FULLSCR' fs.tube 'CONDREAD | VAR SCREEN'                     00320000
Parse Var screen 1 aid 2 cursor 4 screen                                00330000
                                                                        00340000
Do Forever                                                              00350000
                                                                        00360000
    'PEEKTO PROMPT'                                                     00370000
    If rc ^= 0 Then Leave                                               00380000
                                                                        00390000
    Parse Var prompt prompt ';' preset                                  00400000
    prompt = Strip(prompt)                                              00410000
    preset = Strip(preset)                                              00420000
                                                                        00430000
    /* --------------------------------------------------------- GPROMPT00440000
     *  Present a prompt and read from the Gopher user's screen.        00450000
     *  Preset response data may have been supplied.                    00460000
     */                                                                 00470000
                                                                        00480000
    prompt = fs.write || 'C3'x || screen || ,                           00490000
            sba(1,-1) || field("PROT","GREEN") || prompt ,              00500000
            || field("HIGH","WHITE") || '13'x || preset || ,            00510000
            Copies('00'x,fs.scrcols*2-Length(prompt)-Length(preset)-4) ,00520000
            || field("PROT")                                            00530000
                                                                        00540000
    'CALLPIPE VAR PROMPT | FULLSCR' fs.tube '| VAR RS'                  00550000
    Parse Var rs With 1 aid 2 . 4 rs                                    00560000
                                                                        00570000
    If  aid = '7D'x   /* enter */   Then Do                             00580000
        Parse Var rs With . '11'x rs                                    00590000
        rs = Substr(rs,3)                                               00600000
        If rs = "" Then rs = preset                                     00610000
        'OUTPUT' rs                                                     00620000
        End  /*  If  ..  Do  */                                         00630000
                                                                        00640000
    Else 'OUTPUT'                                                       00650000
                                                                        00660000
    'CALLPIPE VAR CURSOR | SPEC /00C311/ X2C 1 1.2 NEXT' ,              00670000
            '/13/ X2C NEXT | FULLSCR' fs.tube 'NOREAD | HOLE'           00680000
                                                                        00690000
    'READTO'                                                            00700000
                                                                        00710000
    End  /*  Do  Forever  */                                            00720000
                                                                        00730000
Exit rc * (rc ^= 12)                                                    00740000
                                                                        00750000
                                                                        00760000
                                                                        00770000
                                                                        00780000
/* ----------------------------------------------------------------- SBA00790000
 * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)      00800000
 * Construct Set Buffer Address order from row and column.              00810000
 */                                                                     00820000
                                                                        00830000
SBA:      Procedure Expose fs.                                          00840000
                                                                        00850000
arg row , col, .                                                        00860000
row = Trunc(row)                                                        00870000
col = Trunc(col)                                                        00880000
                                                                        00890000
/*-----------------------------------------------------------------*/   00900000
/* Calculate binary address.                                       */   00910000
/*-----------------------------------------------------------------*/   00920000
                                                                        00930000
offset = row * fs.scrcols + col                                         00940000
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End     00950000
                                                                        00960000
if fs.14bit then return '11'x || d2c(offset,2)                          00970000
                                                                        00980000
/*-----------------------------------------------------------------*/   00990000
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/   01000000
/*-----------------------------------------------------------------*/   01010000
                                                                        01020000
'CALLPIPE var offset'               ,   /* Start with char number.    */01030000
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */01040000
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */01050000
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */01060000
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */01070000
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */01080000
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */01090000
                '01-09 C1-C9'       ,   /*   buffer address.          */01100000
                '11-19 D1-D9'       ,   /*                            */01110000
                '22-29 E2-E9'       ,   /*                            */01120000
                '30-39 F0-F9'       ,   /*                            */01130000
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */01140000
    '| var offset'                      /* Put back in variable.      */01150000
                                                                        01160000
Return offset                                                           01170000
                                                                        01180000
                                                                        01190000
                                                                        01200000
/* --------------------------------------------------------------- FIELD01210000
 * Generate the 3270 DS sequence for extended field attributes          01220000
 * (if available).                                                      01230000
 */                                                                     01240000
FIELD:    Procedure Expose fs.                                          01250000
a = '00'x                                                               01260000
b = '00'x                                                               01270000
c = 'F1'x                                                               01280000
i = 1                                                                   01290000
Do While Arg(i) ^= ""                                                   01300000
    Select  /*  at  */                                                  01310000
        When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)     01320000
        When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)     01330000
        When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)     01340000
        When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)     01350000
        When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)     01360000
        When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)     01370000
        When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)     01380000
        When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x              01390000
        When Abbrev("RED",Arg(i),3)         Then c = 'F2'x              01400000
        When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x              01410000
        When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x              01420000
        When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x              01430000
        When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x              01440000
        When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x              01450000
        Otherwise nop                                                   01460000
        End  /*  Select  at  */                                         01470000
    i = i + 1                                                           01480000
    End  /*  Do  While  */                                              01490000
                                                                        01500000
If  ^fs.color   | ,                                                     01510000
    ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)                  01520000
                Else    Return '2902'x || ,                             01530000
                               'C0'x   || bitor(a,'40'x) || ,           01540000
                               '42'x   || bitor(c,'40'x)                01550000
                                                                        01560000
:READ  GOPCLITX $REXX    A1 TMP200 01/25/93 15:25:26
/*                                                                      00010000
 *        Name: GOPCLITX REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client plain-text processor    00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23                                             00050000
 *                                                                      00060000
 *       Input: raw ASCII text                                          00070000
 *      Output: plain (EBCDIC) text                                     00080000
 */                                                                     00090000
                                                                        00100000
/*                                                                      00110000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00120000
 *      with resources provided by Rice University and is intended      00130000
 *      to serve Rice's user community.   Rice has benefitted greatly   00140000
 *      from the free distribution of software,  therefore distribution 00150000
 *      of unmodified copies of this material is not restricted.        00160000
 *      You may change your own copy as needed.   Neither Rice          00170000
 *      University nor any of its employees or students shall be held   00180000
 *      liable for damages resulting from the use of this software.     00190000
 */                                                                     00200000
                                                                        00210000
/*  Trace "OFF"  */                                                     00220000
                                                                        00230000
/*  sync with input so that 'CALLPIPE COMMAND' will work  */            00240000
'PEEKTO'                                                                00250000
                                                                        00260000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER GET GOPHER'                     00270000
If gopher = "" Then gopher = "Gopher"                                   00280000
                                                                        00290000
'ADDPIPE *: | DEBLOCK LINEND 0A | DROP LAST 1' ,                        00300000
        '| CHANGE' '000D002000'x '| TCPA2E' gopher '| *.INPUT:'         00310000
                                                                        00320000
/*                                                                      00330000
 *        Name: DROPDOTS REXX                                           00340000
 *              drop trailing lines consisting of only "."              00350000
 *              (typically used for end-of-file indication)             00360000
 *        Date: 1992-Apr-18, 20                                         00370000
 */                                                                     00380000
                                                                        00390000
dots = 0                                                                00400000
'READTO LINE'                                                           00410000
Do While rc = 0                                                         00420000
    If Left(line,1) = "." Then Do                                       00430000
        dots = dots + 1                                                 00440000
        line.dots = line                                                00450000
        End  /*  If  ..  Do  */                                         00460000
    Else Do                                                             00470000
        Do i = 1 to dots;  'OUTPUT' line.i;  End                        00480000
        dots = 0                                                        00490000
        'OUTPUT' line                                                   00500000
        End  /*  Else  Do  */                                           00510000
    'READTO LINE'                                                       00520000
    End  /*  Do  While  */                                              00530000
                                                                        00540000
Exit                                                                    00550000
                                                                        00560000
:READ  GOPCLIFV $REXX    A1 TMP200 01/25/93 15:25:22
/*                                                                      00010000
 *        Name: GOPCLIFV REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client file viewer             00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-23                                             00050000
 *                                                                      00060000
 *       Input: a plain-text file to view                               00070000
 *      Output: zero or more information or error messages              00080000
 */                                                                     00090000
                                                                        00100000
/*                                                                      00110000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00120000
 *      with resources provided by Rice University and is intended      00130000
 *      to serve Rice's user community.   Rice has benefitted greatly   00140000
 *      from the free distribution of software,  therefore distribution 00150000
 *      of unmodified copies of this material is not restricted.        00160000
 *      You may change your own copy as needed.   Neither Rice          00170000
 *      University nor any of its employees or students shall be held   00180000
 *      liable for damages resulting from the use of this software.     00190000
 */                                                                     00200000
                                                                        00210000
Trace "OFF"                                                             00220000
                                                                        00230000
Parse Arg args '(' . ')' .                                              00240000
                                                                        00250000
/*  verify availability of input  */                                    00260000
'PEEKTO'                                                                00270000
If rc ^= 0 & rc ^= 12 Then Exit rc                                      00280000
If rc = 12 Then Do  /*  Warning: file is empty  */                      00290000
    'CALLPIPE COMMAND XMITMSG 559 (ERRMSG | *:'                         00300000
    Exit                                                                00310000
    End  /*  If  ..  Do  */                                             00320000
                                                                        00330000
Address "COMMAND" 'GLOBALV SELECT GOPHER GET' ,                         00340000
        'GOPHER PROGID VIEWER ITEM'                                     00350000
quit = 0                                                                00360000
                                                                        00370000
Parse Var item name '05'x path '05'x host '05'x port '05'x xtra         00380000
Parse Var name 1 . 2 name       /*  discard type indicator byte  */     00390000
Parse Var path 1 . 2 path       /*  discard type indicarot byte  */     00400000
If name = "" Then name = args                                           00410000
                                                                        00420000
/*  fetch fs. stem variable from GlobalVs  */                           00430000
'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,                  00440000
        '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'           00450000
If rc ^= 0 Then Address "COMMAND" 'EXEC GOPCLINI'                       00460000
If ^Datatype(fs.tube,'X') Then fs.tube = ""                             00470000
                                                                        00480000
message.0 = 0                                                           00490000
command = ""                                                            00500000
                                                                        00510000
Select  /*  viewer  */                                                  00520000
    When viewer = ""         Then Call BUILT_IN                         00530000
    When viewer = "XEDIT"    Then Call XEDIT                            00540000
    When viewer = "BROWSE"   Then Call BROWSE                           00550000
    Otherwise                     Call ANYOTHER                         00560000
    /*                                                                  00570000
        handle disk-full conditions!                                    00580000
     */                                                                 00590000
    End  /*  Select  viewer  */                                         00600000
vrc = rc                                                                00610000
                                                                        00620000
'CALLPIPE STEM MESSAGE. | *:'                                           00630000
                                                                        00640000
Parse Upper Var command cmdverb .                                       00650000
Address "COMMAND" 'GLOBALV SELECT GOPHER PUT' ,                         00660000
        'COMMAND CMDVERB'                                               00670000
                                                                        00680000
Exit vrc                                                                00690000
                                                                        00700000
                                                                        00710000
/* ============================================================ BUILT_IN00720000
 */                                                                     00730000
BUILT_IN:                                                               00740000
                                                                        00750000
/*  read the file from the preceding stage  */                          00760000
'CALLPIPE *: | EXPAND | XLATE OUTPUT | XLATE *-* 00-3F 40 FF 40' ,      00770000
        '| DEBLOCK FIXED' fs.scrcols + 1 '| STEM FILE.'                 00780000
                                                                        00790000
/*  display the file and process user's response  */                    00800000
row = 3;        col = 0                                                 00810000
ki = file.0;    kl = fs.scrrows - 5;    ko = 1                          00820000
needle = ""     /*  may be re-used within this context  */              00830000
                                                                        00840000
'CALLPIPE COMMAND XMITMSG 614 (APPLID GOP' ,                            00850000
        'NOCOMP NOHEADER | STEM HELP.'                                  00860000
                                                                        00870000
'CALLPIPE COMMAND XMITMSG 5 (APPLID GOP NOHEADER | VAR MORE'            00880000
                                                                        00890000
Do Forever                                                              00900000
                                                                        00910000
    /*  write the program title line  */                                00920000
    wscreen = sba(0,-1) || field("BLUE","PROT") || sba(0,0) || progid , 00930000
                        || sba(0,fs.scrcols-Length(host)-1) || host     00940000
                                                                        00950000
    /*  no SBA for status because it follows host immediately  */       00960000
    If message.0 < 1 Then Do                                            00970000
    wscreen = wscreen   || field("PROT") || Left(ko || '/' || ki, 11)   00980000
    If ko + kl <= ki Then                                               00990000
    wscreen = wscreen   || field("WHITE","HIGH","PROT") || more         01000000
        End  /*  If  ..  Do  */                                         01010000
                                                                        01020000
    /*  don't write status or name if they'll be overlaid  */           01030000
    If message.0 < 2 Then                                               01040000
    wscreen = wscreen   || sba(2,(fs.scrcols-Length(name))/2) ,         01050000
                        || field("WHITE","PROT") || name                01060000
                                                                        01070000
    /*  write as many message lines as needed  */                       01080000
    If message.0 > 0 Then Do                                            01090000
        Do i = 1 to message.0                                           01100000
            wscreen = wscreen || sba(i,-1) ,                            01110000
                || field("RED","HIGH","PROT") || message.i              01120000
            End  /*  Do  For  */                                        01130000
        message.0 = 0                                                   01140000
        End  /*  If  ..  Do  */                                         01150000
    /*  we should probably limit that count  */                         01160000
                                                                        01170000
    /*  write those PFkey settings  */                                  01180000
    wscreen = wscreen   || sba(fs.scrrows-2,-1) ,                       01190000
                        || field("BLUE","PROT") ,                       01200000
                        || help.1 ,                                     01210000
                        || sba(fs.scrrows-1,-1) ,                       01220000
                        || field("BLUE","PROT") ,                       01230000
                        || help.2                                       01240000
                                                                        01250000
    i = 1; j = ko                                                       01260000
    Do While i <= kl & j <= ki                                          01270000
                                                                        01280000
/*      'CALLPIPE VAR FILE.' || i '| XLATE OUTPUT' ,                    01290000
            '| XLATE *-* 00-3F 40 FF 40 | VAR _LINE'                  */01300000
                                                                        01310000
        wscreen = wscreen || sba(i+2,-1) || field("GREEN","PROT")       01320000
        wscreen = wscreen || file.j                                     01330000
        i = i + 1;  j = j + 1                                           01340000
        End                                                             01350000
                                                                        01360000
    rscreen = write_read(wscreen || sba(row,col) || '13'x)              01370000
    Parse Var rscreen 1 aid 2 offset . '11'x rscreen                    01380000
    offset = fix(offset)                                                01390000
    row = offset % fs.scrcols; col = offset // fs.scrcols               01400000
                                                                        01410000
    /*  keep the  row/col  values within bounds  */                     01420000
    row = 3     /* just reset it */                                     01430000
    col = 0     /* just reset it */                                     01440000
                                                                        01450000
    Select /* aid */                                                    01460000
        When  aid = '7D'x   /* enter */ Then nop                        01470000
        When  aid = 'F2'x   /*  PF2  */ | ,                             01480000
              aid = 'C2'x   /*  PF14 */ | ,                             01490000
              aid = '7B'x   /*  PF11 */ | ,                             01500000
              aid = '4B'x   /*  PF23 */ Then Call SUBXEDIT              01510000
        When  aid = 'F3'x   /*  PF3  */ | ,                             01520000
              aid = 'C3'x   /*  PF15 */ Then Leave                      01530000
        When  aid = 'F4'x   /*  PF4  */ | ,                             01540000
              aid = 'C4'x   /*  PF16 */ Then Call PRINT                 01550000
        When  aid = 'F5'x   /*  PF5  */ | ,                             01560000
              aid = 'C5'x   /*  PF17 */ Then Call SAVE                  01570000
        When  aid = 'F6'x   /*  PF6  */ | ,                             01580000
              aid = 'C6'x   /*  PF18 */ Then Call FIND                  01590000
        When  aid = 'F7'x   /*  PF7  */ | ,                             01600000
              aid = 'C7'x   /*  PF19 */ Then ko = Max(ko-kl+1,1)        01610000
        When  aid = 'F8'x   /*  PF8  */ | ,                             01620000
              aid = 'C8'x   /*  PF20 */ Then ko = Min(ko+kl-1,ki)       01630000
        When  aid = 'F9'x   /*  PF9  */ | ,                             01640000
              aid = 'C9'x   /*  PF21 */ Then  Call  MARK                01650000
        When  aid = '7A'x   /*  PF10 */ | ,                             01660000
              aid = '4A'x   /*  PF22 */ Then  Call  BOOKLIST            01670000
        When  aid = '6D'x   /* clear */ | ,                             01680000
              aid = '6E'x   /*  PA2  */ Then Do                         01690000
            row = 3; col = 0; ko = 1                                    01700000
            End  /*  When ..  Do  */                                    01710000
        When  aid = '7C'x   /*  PF12 */ | ,                             01720000
              aid = '4C'x   /*  PF24 */ | ,                             01730000
              aid = 'F0'x   /* sysrq */ | ,                             01740000
              aid = '6C'x   /*  PA1  */ Then  quit = 1                  01750000
        When  aid = 'F1'x   /*  PF1  */ | ,                             01760000
              aid = 'C1'x   /*  PF13 */ Then  Call  HELP                01770000
        When  aid = '00'x               Then Do                         01780000
            /*  I/O error on screen  */                                 01790000
            'CALLPIPE COMMAND XMITMSG 925 (APPLID GOP' ,                01800000
                    'CALLER FVW ERRMSG | STEM MESSAGE. APPEND'          01810000
              Leave                                                     01820000
              End                                                       01830000
        Otherwise  Do   /*  Undefined PFkey/PAkey  */                   01840000
            'CALLPIPE COMMAND XMITMSG 657 "' || c2x(aid) || '"' ,       01850000
                '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'  01860000
            End  /*  Otherwise  Do  */                                  01870000
        End  /*  Select  aid  */                                        01880000
                                                                        01890000
    If quit Then Leave                                                  01900000
                                                                        01910000
    End  /*  Do  Forever  */                                            01920000
                                                                        01930000
If quit Then command = "QUIT"                                           01940000
                                                                        01950000
Return                                                                  01960000
                                                                        01970000
                                                                        01980000
                                                                        01990000
/* =============================================================== XEDIT02000000
 *  Take the "file" from the input stream and pass it to CMS XEDIT.     02010000
 */                                                                     02020000
XEDIT:                                                                  02030000
                                                                        02040000
If fs.tube ^= "" Then Do                                                02050000
    /*  "Can't run XEDIT on this terminal."  */                         02060000
    'CALLPIPE COMMAND XMITMSG 512 "XEDIT"' ,                            02070000
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'      02080000
    Return                                                              02090000
    End /* If .. Do */                                                  02100000
                                                                        02110000
/*  stash this in a temporary file  */                                  02120000
'CALLPIPE *: | > VMGOPHER DOCUMENT A3'                                  02130000
                                                                        02140000
/*  what's the real name of the file?  */                               02150000
Parse Value gopclifi(path) With fn ft .                                 02160000
Push "COMMAND SET FNAME" fn                                             02170000
Push "COMMAND SET FTYPE" ft                                             02180000
Push "COMMAND SET FMODE A1"                                             02190000
                                                                        02200000
/*  now invoke XEDIT  */                                                02210000
'CALLPIPE COMMAND STATE GOPXEDPR XEDIT *'                               02220000
If rc = 0 Then Address "COMMAND" ,                                      02230000
                'XEDIT VMGOPHER DOCUMENT A (PROFILE GOPXEDPR'           02240000
          Else Address "COMMAND" ,                                      02250000
                'XEDIT VMGOPHER DOCUMENT A'                             02260000
                                                                        02270000
Return                                                                  02280000
                                                                        02290000
                                                                        02300000
                                                                        02310000
/* ============================================================== BROWSE02320000
 *  Take the "file" from the input stream and pass it to CMS BROWSE.    02330000
 */                                                                     02340000
BROWSE:                                                                 02350000
                                                                        02360000
If fs.tube ^= "" Then Do                                                02370000
    /*  "Can't run BROWSE on this terminal."  */                        02380000
    'CALLPIPE COMMAND XMITMSG 512 "BROWSE"' ,                           02390000
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'      02400000
    Return                                                              02410000
    End /* If .. Do */                                                  02420000
                                                                        02430000
Parse Value gopclifi(path) With fn ft .                                 02440000
filespec = fn ft 'A'                                                    02450000
                                                                        02460000
'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'                         02470000
If  rc ^= 0 & rc ^= 28 & rc ^= 20  Then Return                          02480000
If  rc = 0 | rc = 20  Then Do                                           02490000
    fn = "VMGOPHER"                                                     02500000
    ft = "DOCUMENT"                                                     02510000
    End  /*  If  ..  Do  */                                             02520000
message.0 = 0                                                           02530000
                                                                        02540000
/*  stash this in a temporary file  */                                  02550000
'CALLPIPE *: | >' fn ft 'A3'                                            02560000
                                                                        02570000
/* stash this in a temporary file and invoke BROWSE */                  02580000
Address "COMMAND" 'BROWSE' filespec                                     02590000
                                                                        02600000
Return                                                                  02610000
                                                                        02620000
                                                                        02630000
                                                                        02640000
/* ============================================================ ANYOTHER02650000
 *  View the file with some unknown text editor or file browser.        02660000
 */                                                                     02670000
ANYOTHER:                                                               02680000
                                                                        02690000
If fs.tube ^= "" Then Do                                                02700000
    /*  "Can't run" viewer "on this terminal."  */                      02710000
    'CALLPIPE COMMAND XMITMSG 512 VIEWER' ,                             02720000
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'      02730000
    Return                                                              02740000
    End /* If .. Do */                                                  02750000
                                                                        02760000
Parse Value gopclifi(path) With fn ft .                                 02770000
filespec = fn ft 'A'                                                    02780000
                                                                        02790000
'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'                         02800000
If  rc ^= 0 & rc ^= 28 & rc ^= 20  Then Return                          02810000
If  rc = 0 | rc = 20  Then Do                                           02820000
    fn = "VMGOPHER"                                                     02830000
    ft = "DOCUMENT"                                                     02840000
    End  /*  If  ..  Do  */                                             02850000
message.0 = 0                                                           02860000
                                                                        02870000
/*  stash this in a temporary file  */                                  02880000
'CALLPIPE *: | >' fn ft 'A3'                                            02890000
                                                                        02900000
/* stash this in a temporary file and invoke the viewer  */             02910000
'CALLPIPE CMS' viewer filespec '| CONSOLE'                              02920000
                                                                        02930000
Return                                                                  02940000
                                                                        02950000
                                                                        02960000
                                                                        02970000
/* ---------------------------------------------------------------- HELP02980000
 * Invoke CMS HELP passing any supplied argument (context sensitive).   02990000
 */                                                                     03000000
HELP:     Procedure Expose fs. message.                                 03010000
                                                                        03020000
If fs.tube ^= "" Then                                                   03030000
    'CALLPIPE COMMAND HELP GOPHER VIEWER (ALL' ,                        03040000
        '| GOPCLIFV VIEWER HELP' ,                                      03050000
            '| STEM MESSAGE. APPEND'                                    03060000
                                                                        03070000
Else Do                                                                 03080000
    'CALLPIPE COMMAND HELP GOPHER VIEWER'                               03090000
    Address "COMMAND" 'VMFCLEAR'                                        03100000
    End  /*  Else  Do  */                                               03110000
                                                                        03120000
Return                                                                  03130000
                                                                        03140000
                                                                        03150000
                                                                        03160000
/* ------------------------------------------------------------ SUBXEDIT03170000
 *  Take the file in storage and pass it to CMS XEDIT.                  03180000
 */                                                                     03190000
SUBXEDIT:                                                               03200000
                                                                        03210000
If fs.tube ^= "" Then Do                                                03220000
    /*  "Can't run XEDIT on this terminal."  */                         03230000
    'CALLPIPE COMMAND XMITMSG 512 "XEDIT"' ,                            03240000
            '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'      03250000
    Return                                                              03260000
    End /* If .. Do */                                                  03270000
                                                                        03280000
/*  stash this in a temporary file  */                                  03290000
'CALLPIPE STEM FILE. | > VMGOPHER DOCUMENT A3'                          03300000
                                                                        03310000
/*  what's the real name of the file?  */                               03320000
Parse Value gopclifi(path) With fn ft .                                 03330000
Push "COMMAND SET FNAME" fn                                             03340000
Push "COMMAND SET FTYPE" ft                                             03350000
Push "COMMAND SET FMODE A1"                                             03360000
                                                                        03370000
/*  now invoke XEDIT  */                                                03380000
'CALLPIPE COMMAND STATE GOPXEDPR XEDIT *'                               03390000
If rc = 0 Then Address "COMMAND" ,                                      03400000
                'XEDIT VMGOPHER DOCUMENT A (PROFILE GOPXEDPR'           03410000
          Else Address "COMMAND" ,                                      03420000
                'XEDIT VMGOPHER DOCUMENT A'                             03430000
                                                                        03440000
Return                                                                  03450000
                                                                        03460000
                                                                        03470000
                                                                        03480000
/* --------------------------------------------------------------- PRINT03490000
 *  Take the current "file" in context and send it to the user's        03500000
 *  virtual printer.  Printer may be SPOOLed CONTinuous.                03510000
 */                                                                     03520000
PRINT:                                                                  03530000
                                                                        03540000
If fs.tube ^= "" Then Do                                                03550000
    /*  "Can't PRINT from this terminal."  */                           03560000
    'CALLPIPE COMMAND XMITMSG 507 (APPLID GOP CALLER FVW ERRMSG' ,      03570000
            '| STEM MESSAGE. APPEND'                                    03580000
    Return                                                              03590000
    End /* If .. Do */                                                  03600000
                                                                        03610000
'CALLPIPE STEM FILE. | PRINT (TITLE' name '| STEM MESSAGE. APPEND'      03620000
                                                                        03630000
Return                                                                  03640000
                                                                        03650000
                                                                        03660000
                                                                        03670000
/* ---------------------------------------------------------------- SAVE03680000
 * Save the current file being viewed to the user's A disk.             03690000
 */                                                                     03700000
SAVE:                                                                   03710000
                                                                        03720000
If fs.tube ^= "" Then Do                                                03730000
    Call MESSAGE "Can't SAVE files via this terminal."                  03740000
    Return                                                              03750000
    End /* If .. Do */                                                  03760000
                                                                        03770000
Parse Value gopclifi(path) With fn ft .                                 03780000
filespec = fn ft 'A'                                                    03790000
                                                                        03800000
'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'                         03810000
If rc = 0 Then Do                                                       03820000
    'CALLPIPE COMMAND XMITMSG 24 FILESPEC' ,                            03830000
        '| SPLIT AT /;/ | TAKE | STEM MESSAGE.'                         03840000
    Return                                                              03850000
    End  /*  If  ..  Do  */                                             03860000
If rc ^= 28 Then Return                                                 03870000
message.0 = 0                                                           03880000
                                                                        03890000
'CALLPIPE STEM FILE. | >' filespec                                      03900000
If rc = 0 Then Do                                                       03910000
    /*  Creating new file:  */                                          03920000
    'CALLPIPE COMMAND XMITMSG 571 | STEM MESSAGE. APPEND'               03930000
    message.1 = message.1 filespec                                      03940000
/*  Call message "Created" filespec "from" path  */                     03950000
    End  /*  If  ..  Do  */                                             03960000
                                                                        03970000
Return                                                                  03980000
                                                                        03990000
                                                                        04000000
                                                                        04010000
/* ---------------------------------------------------------------- FIND04020000
 *  Find a particular string within the file being viewed.              04030000
 */                                                                     04040000
FIND:                                                                   04050000
                                                                        04060000
'CALLPIPE COMMAND XMITMSG 602 "' || needle || '" (APPLID GOP' ,         04070000
        'CALLER MNU NOHEADER | GOPCLIUI | VAR NEEDLE'                   04080000
needle = Translate(Strip(needle))                                       04090000
If needle = "" Then Return                                              04100000
                                                                        04110000
Do i = ko + 1 to ki                                                     04120000
    If Index(Translate(file.i),needle) > 0 Then Do                      04130000
        ko = i                                                          04140000
        Return                                                          04150000
        End  /*  If  ..  Do  */                                         04160000
    End  /*  Do  For  */                                                04170000
                                                                        04180000
/*  'CALLPIPE COMMAND XMITMSG 546 (ERRMSG'  CALLER DMS is OK  */        04190000
/*  "Target not found"  */                                              04200000
'CALLPIPE COMMAND XMITMSG 546 (APPLID GOP CALLER MNU ERRMSG' ,          04210000
        '| STEM MESSAGE. APPEND'                                        04220000
                                                                        04230000
Return                                                                  04240000
                                                                        04250000
                                                                        04260000
                                                                        04270000
                                                                        04280000
/* ---------------------------------------------------------------- MARK04290000
 *  Save a book mark referencing this file.                             04300000
 */                                                                     04310000
MARK:                                                                   04320000
                                                                        04330000
If fs.tube ^= "" Then Do                                                04340000
    /*  "Can't set bookmarks from this screen."  */                     04350000
    'CALLPIPE COMMAND XMITMSG 43 (APPLID GOP CALLER FVW ERRMSG' ,       04360000
            '| STEM MESSAGE. APPEND'                                    04370000
    Return                                                              04380000
    End /* If .. Do */                                                  04390000
                                                                        04400000
Address "COMMAND" 'GLOBALV SELECT GOPHER GET BOOKMARK.0'                04410000
If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0                        04420000
i = bookmark.0 + 1                                                      04430000
bookmark.i = item                                                       04440000
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i           04450000
bookmark.0 = i                                                          04460000
Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'               04470000
                                                                        04480000
If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 41 I' ,                        04490000
    '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'              04500000
    /*  "Bookmark" i "saved."  */                                       04510000
          Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,            04520000
        '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'          04530000
                                                                        04540000
Return                                                                  04550000
                                                                        04560000
                                                                        04570000
                                                                        04580000
/* ------------------------------------------------------------ BOOKLIST04590000
 *  Call GOPCLI to show the lit of bookmarks.                           04600000
 */                                                                     04610000
BOOKLIST:                                                               04620000
                                                                        04630000
Address "CMS" 'GOPCLI (BOOKLIST'                                        04640000
                                                                        04650000
Return                                                                  04660000
                                                                        04670000
                                                                        04680000
                                                                        04690000
/* ----------------------------------------------------------------- FIX04700000
 * Takes an inbound 3270 DS screen address (two bytes)                  04710000
 * and returns the equivalent byte offset in decimal.                   04720000
 */                                                                     04730000
FIX:                                                                    04740000
Parse Arg o,.                                                           04750000
Parse Var o 1 o1 2 o2 3 .                                               04760000
o1 = c2d(o1)                                                            04770000
o2 = c2d(o2)                                                            04780000
If o1 < 64 Then Return o1 * 256 + o2                                    04790000
           Else Return (o1 // 64) * 64 + (o2 // 64)                     04800000
                                                                        04810000
                                                                        04820000
                                                                        04830000
/* ---------------------------------------------------------- WRITE_READ04840000
 * Display what we have, then wait for user input and return it.        04850000
 */                                                                     04860000
WRITE_READ: Procedure Expose fs.                                        04870000
Parse Arg ws,wcc,wrt,.                                                  04880000
If wcc = "" Then wcc = 'C3'x                                            04890000
/*  If wrt = "" Then wrt = 'C0'x  */                                    04900000
If wrt = "" Then wrt = fs.write                                         04910000
ws = wrt || wcc || ws                                                   04920000
'CALLPIPE VAR WS | FULLSCR' fs.tube '| VAR RS'                          04930000
If rc ^= 0 Then rs = '000000'x                                          04940000
Return rs                                                               04950000
                                                                        04960000
                                                                        04970000
                                                                        04980000
/* ----------------------------------------------------------------- SBA04990000
 * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)      05000000
 * Construct Set Buffer Address order from row and column.              05010000
 */                                                                     05020000
                                                                        05030000
SBA:      Procedure Expose fs.                                          05040000
                                                                        05050000
arg row , col, .                                                        05060000
row = Trunc(row)                                                        05070000
col = Trunc(col)                                                        05080000
                                                                        05090000
/*-----------------------------------------------------------------*/   05100000
/* Calculate binary address.                                       */   05110000
/*-----------------------------------------------------------------*/   05120000
                                                                        05130000
offset = row * fs.scrcols + col                                         05140000
Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End     05150000
                                                                        05160000
if fs.14bit then return '11'x || d2c(offset,2)                          05170000
                                                                        05180000
/*-----------------------------------------------------------------*/   05190000
/* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/   05200000
/*-----------------------------------------------------------------*/   05210000
                                                                        05220000
'CALLPIPE var offset'               ,   /* Start with char number.    */05230000
    '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */05240000
    '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */05250000
    '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */05260000
           '/00/ 9 11.6 11'         ,   /* Place second six bits.     */05270000
    '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */05280000
    '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */05290000
                '01-09 C1-C9'       ,   /*   buffer address.          */05300000
                '11-19 D1-D9'       ,   /*                            */05310000
                '22-29 E2-E9'       ,   /*                            */05320000
                '30-39 F0-F9'       ,   /*                            */05330000
    '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */05340000
    '| var offset'                      /* Put back in variable.      */05350000
                                                                        05360000
Return offset                                                           05370000
                                                                        05380000
                                                                        05390000
                                                                        05400000
/* --------------------------------------------------------------- FIELD05410000
 * Generate the 3270 DS sequence for extended field attributes          05420000
 * (if available).                                                      05430000
 */                                                                     05440000
FIELD:    Procedure Expose fs.                                          05450000
a = '00'x                                                               05460000
b = '00'x                                                               05470000
c = 'F1'x                                                               05480000
i = 1                                                                   05490000
Do While Arg(i) ^= ""                                                   05500000
    Select  /*  at  */                                                  05510000
        When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)     05520000
        When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)     05530000
        When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)     05540000
        When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)     05550000
        When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)     05560000
        When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)     05570000
        When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)     05580000
        When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x              05590000
        When Abbrev("RED",Arg(i),3)         Then c = 'F2'x              05600000
        When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x              05610000
        When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x              05620000
        When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x              05630000
        When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x              05640000
        When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x              05650000
        Otherwise nop                                                   05660000
        End  /*  Select  at  */                                         05670000
    i = i + 1                                                           05680000
    End  /*  Do  While  */                                              05690000
                                                                        05700000
If  ^fs.color   | ,                                                     05710000
    ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)                  05720000
                Else    Return '2902'x || ,                             05730000
                               'C0'x   || bitor(a,'40'x) || ,           05740000
                               '42'x   || bitor(c,'40'x)                05750000
                                                                        05760000
:READ  GOPCLIGV $REXX    A1 TMP200 01/25/93 15:25:18
/*                                                                      00010000
 *        Name: GOPCLIGV REXX                                           00020000
 *              VM TCP/IP Network GOPHER Client graphics viewer         00030000
 *              This file is part of CMS Gopher and not part of VMGIF.  00040000
 *      Author: Rick Troth, Rice University, Information Systems        00050000
 *        Date: 1992-Dec-23                                             00060000
 *                                                                      00070000
 *        Note: the first record must be at least long enough           00080000
 *              to identify the graphics format (magic number)          00090000
 */                                                                     00100000
                                                                        00110000
/*                                                                      00120000
 *      Copyright 1992 Richard M. Troth.   This software was developed  00130000
 *      with resources provided by Rice University and is intended      00140000
 *      to serve Rice's user community.   Rice has benefitted greatly   00150000
 *      from the free distribution of software,  therefore distribution 00160000
 *      of unmodified copies of this material is not restricted.        00170000
 *      You may change your own copy as needed.   Neither Rice          00180000
 *      University nor any of its employees or students shall be held   00190000
 *      liable for damages resulting from the use of this software.     00200000
 */                                                                     00210000
                                                                        00220000
/*  Trace "OFF"  */                                                     00230000
                                                                        00240000
'PEEKTO RECORD'                                                         00250000
Select                                                                  00260000
    When Left(record,5) = '4749463837'x Then Signal GIF                 00270000
    Otherwise 'OUTPUT' "unknown graphics format"                        00280000
    End  /*  Select  */                                                 00290000
                                                                        00300000
Exit rc * (rc ^= 12)                                                    00310000
                                                                        00320000
                                                                        00330000
                                                                        00340000
/* ------------------------------------------------------------------ */00350000
GIF:                                                                    00360000
                                                                        00370000
/*  verify that we have the VMGIF disk accessed  */                     00380000
'CALLPIPE CMS STATE VMGIF MODULE * | *:'                                00390000
If rc ^= 0 Then Exit rc                                                 00400000
                                                                        00410000
/*  try to stash the input stream in a temp file  */                    00420000
'CALLPIPE *: | > TEMP#GIF GIF A3'                                       00430000
If rc ^= 0 Then Do                                                      00440000
    grc = rc                                                            00450000
    'CALLPIPE COMMAND ERASE TEMP#GIF GIF A'                             00460000
    Exit grc                                                            00470000
    End  /*  If  ..  Do  */                                             00480000
                                                                        00490000
/*  ensure that the right libraries are GLOBALed  */                    00500000
/*  (I loathe doing this)  */                                           00510000
'CALLPIPE COMMAND QUERY TXTLIB' ,                                       00520000
    '| STRIP LEADING STRING /TXTLIB   = / | JOIN * | VAR TXTLIB'        00530000
Upper txtlib;   If Strip(txtlib) = "NONE" Then txtlib = ""              00540000
'CALLPIPE COMMAND GLOBAL TXTLIB ADMPLIB ADMGLIB' txtlib                 00550000
                                                                        00560000
/*  now run VMGIF  */                                                   00570000
'CALLPIPE CMS VMGIF -em5 TEMP#GIF | *:'; grc = rc                       00580000
                                                                        00590000
/*  restore GLOBALed libraries  */                                      00600000
'CALLPIPE COMMAND GLOBAL TXTLIB' txtlib                                 00610000
                                                                        00620000
Exit grc                                                                00630000
                                                                        00640000
:READ  GOPCLIFI $EXEC    A1 TMP200 01/25/93 15:25:07
/*                                                                      00010000
 *        Name: GOPCLIFI EXEC (function)                                00020000
 *              returns a CMS fileid from a gopher path                 00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1992-Dec-10, 1993-Jan-15                                00050000
 *                                                                      00060000
 *              This file is part of CMS Gopher.                        00070000
 */                                                                     00080000
                                                                        00090000
Parse Source . call . . . arg0 .                                        00100000
If call ^= "FUNCTION" Then Do                                           00110000
    Say "Usage:" arg0 || "()"                                           00120000
    Exit                                                                00130000
    End                                                                 00140000
                                                                        00150000
Parse Arg path                                                          00160000
Parse Value Reverse(path) With name '/' path                            00170000
Parse Value Reverse(name) With name ',' . ';' vers                      00180000
                                                                        00190000
/*  input/output tables are built piecemeal to circumvent     *         00200000
 *  the 500 byte clause limit in older interpreters           */        00210000
i   =    '000102030405060708090A0B0C0D0E0F'x || ,                       00220000
         '101112131415161718191A1B1C1D1E1F'x || ,                       00230000
         '202122232425262728292A2B2C2D2E2F'x || ,                       00240000
         '303132333435363738393A3B3C3D3E3F'x                            00250000
                                                                        00260000
i = i || '404142434445464748494A4B4C4D4E4F'x || ,                       00270000
         '505152535455565758595A5B5C5D5E5F'x || ,                       00280000
         '606162636465666768696A6B6C6D6E6F'x || ,                       00290000
         '707172737475767778797A7B7C7D7E7F'x                            00300000
                                                                        00310000
i = i || '808182838485868788898A8B8C8D8E8F'x || ,                       00320000
         '909192939495969798999A9B9C9D9E9F'x || ,                       00330000
         'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x || ,                       00340000
         'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x                            00350000
                                                                        00360000
i = i || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x || ,                       00370000
         'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x || ,                       00380000
         'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x || ,                       00390000
         'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x                            00400000
                                                                        00410000
o   =    '40404040404040404040404040404040'x || ,                       00420000
         '40404040404040404040404040404040'x || ,                       00430000
         '40404040404040404040404040404040'x || ,                       00440000
         '40404040404040404040404040404040'x                            00450000
                                                                        00460000
o = o || '407C7C7C7C7C7C7C7C7C7C407C7C4E7C'x || ,                       00470000
         '7C7C7C7C7C7C7C7C7C7C7C5B7C7C7C7C'x || ,                       00480000
         '607C7C7C7C7C7C7C7C7C7C7C6C6D7C7C'x || ,                       00490000
         '7C7C7C7C7C7C7C7C7C7C7A7B7C7C7C7C'x                            00500000
                                                                        00510000
o = o || '7CC1C2C3C4C5C6C7C8C97C7C7C7C7C7C'x || ,                       00520000
         '7CD1D2D3D4D5D6D7D8D97C7C7C7C7C7C'x || ,                       00530000
         '7C7CE2E3E4E5E6E7E8E97C7C7C7C7C7C'x || ,                       00540000
         '7C7C7C7C7C7C7C7C7C7C7C7C7C7C7C7C'x                            00550000
                                                                        00560000
o = o || '7CC1C2C3C4C5C6C7C8C97C7C7C7C7C7C'x || ,                       00570000
         '7CD1D2D3D4D5D6D7D8D97C7C7C7C7C7C'x || ,                       00580000
         '7C7CE2E3E4E5E6E7E8E97C7C7C7C7C7C'x || ,                       00590000
         'F0F1F2F3F4F5F6F7F8F97C7C7C7C7C7C'x                            00600000
                                                                        00610000
Parse Upper Value Translate(name,o,i) With fn ft .                      00620000
If fn = "" Then fn = "VMGOPHER"                                         00630000
If ft = "" Then ft = "DOCUMENT"                                         00640000
Return fn ft                                                            00650000
                                                                        00660000
:READ  GOPSRV   $EXEC    A1 TMP200 01/25/93 15:24:41
/*                                                                      00010000
 *        Name: GOPSRV EXEC                                             00020000
 *              A CMS-based Gopher Server                               00030000
 *              Based on the original, GOPHERD EXEC, from 2.3.          00040000
 *      Author: Rick Troth, Rice University, Information Systems        00050000
 *        Date: 1992-Apr-21, Aug-07, Oct-14, Dec-11, 1993-Jan-15        00060000
 */                                                                     00070000
                                                                        00080000
/*                                                                      00090000
 *      Copyright 1993 Richard M. Troth.   This software was developed  00100000
 *      with resources provided by Rice University and is intended      00110000
 *      to serve Rice's user community.   Rice has benefitted greatly   00120000
 *      from the free distribution of software,  therefore distribution 00130000
 *      of unmodified copies of this material is not restricted.        00140000
 *      You may change your own copy as needed.   Neither Rice          00150000
 *      University nor any of its employees or students shall be held   00160000
 *      liable for damages resulting from the use of this software.     00170000
 */                                                                     00180000
                                                                        00190000
/*                                                                      00200000
 *       Calls:                                                         00210000
 *              GOPSRVLS REXX     -- to read files and menus            00220000
 *              GOPSRVRP REXX     -- to resolve gopher paths            00230000
 *              GOPSRVMB REXX     -- to build menus for the client      00240000
 *                                                                      00250000
 *        Note: this program does *not* use RXSOCKET's translation      00260000
 *              option.   Translation between ASCII and EBCDIC          00270000
 *              is determined by the type of file requested.            00280000
 */                                                                     00290000
                                                                        00300000
progid = "CMS Gopher 2.4.0 server"                                      00310000
gopher = "Gopher"                                                       00320000
timeout = 5                                                             00330000
                                                                        00340000
Parse Source . . . . . arg0 .                                           00350000
argo = arg0 || ':'                                                      00360000
Parse Upper Arg root port . '(' . ')' .                                 00370000
                                                                        00380000
Address "COMMAND"                                                       00390000
                                                                        00400000
'SET LANGUAGE (ADD GOP USER'                                            00410000
                                                                        00420000
host = "localhost"      /*  this will be reset to the actual name of  * 00430000
                         *  this host after RXSOCKET is initialized.  */00440000
                                                                        00450000
    stdin  = 0                                                          00460000
    stdout = 1                                                          00470000
    stderr = 2                                                          00480000
                                                                        00490000
Say argo progid "starting"                                              00500000
                                                                        00510000
logpipe = "CONSOLE"                                                     00520000
_root = Userid()                                                        00530000
_port = 70                                                              00540000
'PIPE < GOPHERD CONFIG * | STEM CONFIG.'                                00550000
If rc = 0 Then                                                          00560000
Do i = 1 to config.0                                                    00570000
    If Left(config.i,1) = '*' Then Iterate                              00580000
    If Left(config.i,1) = '#' Then Iterate                              00590000
    If Index(config.i,'=') = 0 Then Iterate                             00600000
    Parse Var config.i var '=' val                                      00610000
    Upper var                                                           00620000
    Select  /*  var  */                                                 00630000
        When  Abbrev("LOGPIPE",var,3)   Then  logpipe = val             00640000
        When  Abbrev("ROOT",var,4)      Then  _root = val               00650000
        When  Abbrev("PORT",var,4)      Then  _port = val               00660000
        Otherwise 'XMITMSG 2 VAR (ERRMSG'                               00670000
        End  /*  Select  var  */                                        00680000
    End  /*  Do  For  */                                                00690000
                                                                        00700000
If root = "" Then root = _root                                          00710000
If port = "" Then port = _port                                          00720000
                                                                        00730000
If ^Datatype(port,'N') Then Do                                          00740000
    /*  "Gopher TCP/IP service port must be numeric."  */               00750000
    'XMITMSG 126 (APPLID GOP CALLER SRV ERRMSG'                         00760000
    Exit 24                                                             00770000
    End  /*  If  ..  Do  */                                             00780000
                                                                        00790000
/*                                                                      00800000
 *   Initialize RXSOCKET                                                00810000
 */                                                                     00820000
maxdesc = Socket('Initialize', gopher)                                  00830000
If maxdesc = "-1" Then Do                                               00840000
    Say argo tcperror()                                                 00850000
    Exit -1                                                             00860000
    End  /*  If  ..  Do  */                                             00870000
Say argo "RXSOCKET Initialized for" maxdesc "descriptors"               00880000
                                                                        00890000
                                                                        00900000
/*                                                                      00910000
 *   Request the name of this host                                      00920000
 */                                                                     00930000
rc = Socket('GetHostName', 'HOST')                                      00940000
If rc = "-1" Then Do                                                    00950000
    Say argo tcperror()                                                 00960000
    Exit -1                                                             00970000
    End  /*  If  ..  Do  */                                             00980000
Say argo "LocalHost =" host                                             00990000
                                                                        01000000
                                                                        01010000
/*                                                                      01020000
 *   Request a new socket descriptor (TCP protocol)                     01030000
 */                                                                     01040000
socket = Socket('Socket', 'AF_INET', 'Sock_Stream')                     01050000
If socket = "-1" Then Do                                                01060000
    Say argo tcperror()                                                 01070000
    Exit -1                                                             01080000
    End  /*  If  ..  Do  */                                             01090000
Say argo "Primary socket =" socket                                      01100000
                                                                        01110000
                                                                        01120000
/*                                                                      01130000
 *   Set this socket to non-blocking mode                               01140000
 */                                                                     01150000
rc = Socket('Ioctl', socket, 'FIONBIO', 1)                              01160000
If rc = "-1" Then                                                       01170000
    Say argo tcperror()                                                 01180000
                                                                        01190000
                                                                        01200000
/*                                                                      01210000
 *                                                                      01220000
 */                                                                     01230000
name = AF_INET || Htons(port)                                           01240000
                                                                        01250000
rc = Socket('Bind', socket, name)                                       01260000
If rc = "-1" Then Do                                                    01270000
    Say argo tcperror()                                                 01280000
    Exit -1                                                             01290000
    End  /*  If  ..  Do  */                                             01300000
Say argo "Bound to port" port                                           01310000
                                                                        01320000
                                                                        01330000
/*                                                                      01340000
 *                                                                      01350000
 */                                                                     01360000
rc = Socket('Listen', socket, maxdesc)                                  01370000
If rc = "-1" Then Do                                                    01380000
    Say argo tcperror()                                                 01390000
    Exit -1                                                             01400000
    End  /*  If  ..  Do  */                                             01410000
/*  Say argo "Listening ..."  */                                        01420000
                                                                        01430000
/*  UNIX and VMS style logging:  */                                     01440000
Parse Value Date('S') With 1 yy 5 mm 7 dd 9 .                           01450000
day = Left(Date('W'),3)                                                 01460000
mon = Left(Date('M'),3)                                                 01470000
time = Time()                                                           01480000
userid = Userid()                                                       01490000
/*  "Starting gopher daemon" Userid()  */                               01500000
'PIPE COMMAND XMITMSG 120 DAY MON DD TIME YY HOST USERID' ,             01510000
        '(APPLID GOP CALLER SRV ERRMSG |' logpipe                       01520000
                                                                        01530000
Say argo progid "waiting for a connection"                              01540000
                                                                        01550000
'GLOBALV SELECT GOPHERD PUT HOST PORT ROOT'                             01560000
                                                                        01570000
Do Forever                                                              01580000
                                                                        01590000
    rc = FD_ZERO('readmask')            /* must be reset each time */   01600000
    rc = FD_SET(socket, 'readmask')                                     01610000
    rc = FD_SET(stdin, 'readmask')                                      01620000
                                                                        01630000
    Say "*"     /* waiting */                                           01640000
    rc = Socket('Select', socket + 1, 'readmask', 0, 0, 0)              01650000
    If rc = "-1" Then Do                                                01660000
        Say argo tcperror()                                             01670000
        Leave                                                           01680000
        End  /*  If  ..  Do  */                                         01690000
                                                                        01700000
    If FD_ISSET(stdin, 'readmask') = 1 Then Leave                       01710000
    If FD_ISSET(socket, 'readmask') ^= 1 Then Iterate                   01720000
                                                                        01730000
    /*                                                                  01740000
     *                                                                  01750000
     */                                                                 01760000
    ns = Socket('Accept', socket, 'CLIENT')                             01770000
    If ns = "-1" Then Do                                                01780000
        Say argo tcperror()                                             01790000
        Leave                                                           01800000
        End  /*  If  ..  Do  */                                         01810000
                                                                        01820000
    Say argo "Accepted" ns "at" Time() "client" c2x(client)             01830000
    Parse Var client . 5 r1 +1 r2 +1 r3 +1 r4 +1 .                      01840000
    cipa = c2d(r1) || "." || c2d(r2) || "." || ,                        01850000
           c2d(r3) || "." || c2d(r4)                                    01860000
    /*  Say argo "Client's IP address is" cipa  */                      01870000
                                                                        01880000
    /*  UNIX and VMS style logging:  */                                 01890000
    Parse Value Date('S') With 1 yyyy 5 mm 7 dd 9 .                     01900000
    day = Left(Date('W'),3)                                             01910000
    mon = Left(Date('M'),3)                                             01920000
    time = Time()                                                       01930000
                                                                        01940000
    /*                                                                  01950000
     *   Loop, reading the query line from the client.                  01960000
     */                                                                 01970000
    path = ""                                                           01980000
    Do Forever                                                          01990000
                                                                        02000000
        rc = FD_ZERO('readmask')        /* must be reset each time */   02010000
        rc = FD_SET(ns, 'readmask')                                     02020000
                                                                        02030000
        rc = Socket('Select', ns + 1, 'readmask', 0, 0, timeout)        02040000
        If rc = "-1" Then Do                                            02050000
            Say argo tcperror()                                         02060000
            Exit -1                                                     02070000
            End  /*  If  ..  Do  */                                     02080000
                                                                        02090000
        If FD_ISSET(ns, 'readmask') ^= 1 Then Leave                     02100000
                                                                        02110000
        pack = ""                                                       02120000
        bytes_in = Socket('Read', ns, 'PACK')                           02130000
        If bytes_in = "-1" Then                                         02140000
            Say argo tcperror()                                         02150000
        If bytes_in < 1 Then Leave                                      02160000
        If Index(pack,'0A'x) > 0 Then Leave /* ASCII LF */              02170000
        If Index(pack,'0D'x) > 0 Then Leave /* ASCII CR */              02180000
        path = path || pack                                             02190000
    End                                                                 02200000
    path = path || pack                                                 02210000
                                                                        02220000
    Parse Var path path '0A'x .     /* ASCII LF */                      02230000
    Parse Var path path '0D'x .     /* ASCII CR */                      02240000
    'PIPE VAR PATH | A2E | VAR PATH'                                    02250000
                                                                        02260000
    /*  refresh disk access  (same procedure as used by GONE EXEC)  */  02270000
    'PIPE CMS QUERY DISK | DROP | STEM STEM.'                           02280000
    Do i = 1 to stem.0                                                  02290000
        Parse Var stem.i . 8 va 12 fm .                                 02300000
        If Left(va,3) = "DIR" Then Iterate                              02310000
        'DISKWRIT' Left(fm,1)                                           02320000
        If rc = 1 Then 'ACCESS' va fm                                   02330000
        End  /*  Do  For  */                                            02340000
                                                                        02350000
    client = cipa                                                       02360000
    'GLOBALV SELECT GOPHERD PUT CLIENT'                                 02370000
                                                                        02380000
                                                                        02390000
Parse Var path path '05'x parm                                          02400000
Say argo "Requesting:" path                                             02410000
If parm ^= "" Then Say argo "+ Parms:" parm                             02420000
                                                                        02430000
Select  /*  type  */                                                    02440000
                                                                        02450000
    When path = "" Then Do                                              02460000
        type = '1'                                                      02470000
        logmsg = 121    /*  "Root Connection"  */                       02480000
        End  /*  When  ..  Do  */                                       02490000
                                                                        02500000
    When Left(path,1) = '1' Then Do                                     02510000
        Parse Var path 1 type 2 path                                    02520000
        logmsg = 122    /*  "retrieved directory" path  */              02530000
        End  /*  When  ..  Do  */                                       02540000
                                                                        02550000
    When Left(path,1) = '7' Then Do                                     02560000
        Parse Var path 1 type 2 path                                    02570000
        logmsg = 125    /*  "searched directory" path  */               02580000
        End  /*  When  ..  Do  */                                       02590000
                                                                        02600000
    When Left(path,1) = '/' Then Do                                     02610000
        type = '0'                                                      02620000
        logmsg = 123    /*  "retrieved file" path  */                   02630000
        End  /*  When  ..  Do  */                                       02640000
                                                                        02650000
    Otherwise Do                                                        02660000
        Parse Var path 1 type 2 path                                    02670000
        logmsg = 123    /*  "retrieved file" path  */                   02680000
        End  /*  Otherwise  Do  */                                      02690000
                                                                        02700000
    End  /*  Select  type  */                                           02710000
                                                                        02720000
'GLOBALV SELECT GOPHERD PUT PATH PARM'                                  02730000
'GLOBALV SELECT GOPHERD SET MENU'                                       02740000
                                                                        02750000
Select  /*  type  */                                                    02760000
                                                                        02770000
    When type = "0" Then        /* plain text file */                   02780000
        pipe = 'APPEND LITERAL .' || ,                                  02790000
            '| E2A | SPEC 1-* 1 x0D0A NEXT'                             02800000
                                                                        02810000
    When type = "1" Then        /* menu */                              02820000
        pipe = 'GOPSRVMB | APPEND LITERAL .' || ,                       02830000
            '| E2A | SPEC 1-* 1 x0D0A NEXT'                             02840000
                                                                        02850000
    When type = "7" Then        /* menu with search */                  02860000
        pipe = 'GOPSRVYS' parm '| GOPSRVMB | APPEND LITERAL .' || ,     02870000
            '| E2A | SPEC 1-* 1 x0D0A NEXT'                             02880000
                                                                        02890000
    When type = "9" | ,         /* binary */                            02900000
         type = "4" | ,         /* Mac file, send as binary */          02910000
         type = "5" | ,         /* PC file, send as binary */           02920000
         type = "I" | ,         /* send pictures as binary */           02930000
         type = "s" Then        /* sound, send as binary */             02940000
pipe = 'FBLOCK 8192'    /*  default processing  */                      02950000
                                                                        02960000
    When type = "p" Then        /* PostScript */                        02970000
        pipe = 'E2A | SPEC 1-* 1 x0D0A NEXT'                            02980000
                                                                        02990000
    When type = "r" | ,         /* record oriented file */              03000000
         type = "v" Then        /* var-length records */                03010000
        pipe = 'BLOCK 65531 CMS |' pipe                                 03020000
                                                                        03030000
    Otherwise                   /* send it as binary */                 03040000
pipe = 'FBLOCK 8192'    /*  default processing  */                      03050000
                                                                        03060000
    End  /*  Select  type  */                                           03070000
                                                                        03080000
    'PIPE GOPSRVLS' root '| GOPSRVRP' path ,                            03090000
            '|' pipe '| FBLOCK 8192 | STEM STEM.'                       03100000
                                                                        03110000
/*  If rc ^= 0 Then logrqest = logrqest "(rc=" || rc || ")"  */         03120000
                                                                        03130000
'PIPE COMMAND XMITMSG' logmsg 'DAY MON DD TIME YY CLIENT PATH' ,        03140000
        '(APPLID GOP CALLER SRV ERRMSG |' logpipe                       03150000
                                                                        03160000
                                                                        03170000
    Say argo stem.0 "blocks to send"                                    03180000
    /*                                                                  03190000
     *   Send the response to our client                                03200000
     */                                                                 03210000
    Do i = 1 to stem.0                                                  03220000
        bytes_out = Socket('Write', ns, stem.i)                         03230000
        If bytes_out = "-1" Then Do                                     03240000
            Say argo tcperror()                                         03250000
            Leave                                                       03260000
            End  /*  If  ..  Do  */                                     03270000
        End  /*  Do  For  */                                            03280000
                                                                        03290000
                                                                        03300000
    /*                                                                  03310000
     *   All done, relinquish our socket descriptor                     03320000
     */                                                                 03330000
    rc = Socket('Close', ns)                                            03340000
    If rc = "-1" Then Do                                                03350000
        Say argo tcperror()                                             03360000
        Leave                                                           03370000
        End  /*  If  ..  Do  */                                         03380000
    Say argo "Closed" ns "at" Time()                                    03390000
                                                                        03400000
                                                                        03410000
    End  /*  Do  Forever  */                                            03420000
                                                                        03430000
                                                                        03440000
/*                                                                      03450000
 *   Tell RXSOCKET that we are done with this IUCV path                 03460000
 */                                                                     03470000
rc = Socket('Terminate')                                                03480000
If rc = "-1" Then Do                                                    03490000
    Say argo tcperror()                                                 03500000
    End  /*  If  ..  Do  */                                             03510000
                                                                        03520000
                                                                        03530000
Exit                                                                    03540000
                                                                        03550000
:READ  GOPSRVLS $REXX    A1 TMP200 01/25/93 15:24:37
/*                                                                      00010000
 *        Name: GOPSRVLS REXX                                           00020000
 *              list a file or directory, feeding to the next stage     00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1993-Jan-15, 19                                         00050000
 */                                                                     00060000
                                                                        00070000
/*                                                                      00080000
 *      Copyright 1993 Richard M. Troth.   This software was developed  00090000
 *      with resources provided by Rice University and is intended      00100000
 *      to serve Rice's user community.   Rice has benefitted greatly   00110000
 *      from the free distribution of software,  therefore distribution 00120000
 *      of unmodified copies of this material is not restricted.        00130000
 *      You may change your own copy as needed.   Neither Rice          00140000
 *      University nor any of its employees or students shall be held   00150000
 *      liable for damages resulting from the use of this software.     00160000
 */                                                                     00170000
                                                                        00180000
Parse Source . . arg0 .                                                 00190000
Parse Upper Arg fn ft fm . '(' . ')' .                                  00200000
If fn = "" Then fn = '*'                                                00210000
If ft = "" Then ft = '*'                                                00220000
If ft = "FILELIST" & Index(fn,'*') = 0 Then ft = "*"                    00230000
If fm = "" Then fm = '*'                                                00240000
                                                                        00250000
Parse Arg string                                                        00260000
Say arg0 || ':' string                                                  00270000
                                                                        00280000
Address "COMMAND" 'GLOBALV SELECT GOPHERD GET MENU NICK CLIENT'         00290000
                                                                        00300000
If menu ^= "" Then Do                                                   00310000
                                                                        00320000
                                                                        00330000
    Address "CMS" 'STATE' menu 'NAMES *'                                00340000
    If rc = 0 Then Do                                                   00350000
                                                                        00360000
        If nick = "" Then nick = "*"                                    00370000
                                                                        00380000
        'CALLPIPE COMMAND NAMEFIND :NICK' nick ':AUTH :PIPE' ,          00390000
                '(FILE' menu '| VAR AUTH | DROP' ,                      00400000
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,            00410000
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,            00420000
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,            00430000
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,            00440000
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,            00450000
                '| VAR PIPE'                                            00460000
                                                                        00470000
        If rc = 32 Then                                                 00480000
        'CALLPIPE COMMAND NAMEFIND :FN' fn ':FT' ft ':AUTH :PIPE' ,     00490000
                '(FILE' menu '| VAR AUTH | DROP' ,                      00500000
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,            00510000
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,            00520000
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,            00530000
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,            00540000
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,            00550000
                '| VAR PIPE'                                            00560000
                                                                        00570000
        If rc = 32 Then                                                 00580000
        'CALLPIPE COMMAND NAMEFIND :NICK * :AUTH :PIPE' ,               00590000
                '(FILE' menu '| VAR AUTH | DROP' ,                      00600000
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,            00610000
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,            00620000
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,            00630000
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,            00640000
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,            00650000
                '| VAR PIPE'                                            00660000
                                                                        00670000
        If rc = 0 Then Do                                               00680000
                                                                        00690000
            /*  if auth non-blank  */                                   00700000
            If ^gopsrvau(client,auth) Then Do                           00710000
                /*  "access restricted"  */                             00720000
                'CALLPIPE COMMAND XMITMSG 2380' ,                       00730000
                    '(CALLER GOP ERRMSG' ,                              00740000
                        '| SPEC /- / 1 1-* NEXT | *:'                   00750000
                Exit rc                                                 00760000
                End  /*  If  ..  Do  */                                 00770000
                                                                        00780000
            If pipe ^= "" Then Do                                       00790000
                'CALLPIPE' pipe '| *:'                                  00800000
                Exit rc                                                 00810000
                End  /*  If  ..  Do  */                                 00820000
                                                                        00830000
            End  /*  If  ..  Do  */                                     00840000
                                                                        00850000
        End  /*  If  ..  Do  */                                         00860000
                                                                        00870000
    End  /*  If  ..  Do  */                                             00880000
                                                                        00890000
If ft = '*' Then Do                                                     00900000
                                                                        00910000
    Address "CMS" 'STATE' fn 'NAMES *'                                  00920000
    If rc = 0 Then Do                                                   00930000
                                                                        00940000
        'CALLPIPE COMMAND NAMEFIND :NICK . :AUTH :PIPE' ,               00950000
                '(FILE' fn '| VAR AUTH | DROP' ,                        00960000
        '| CHANGE' '00'x || '&0' || '00'x || nick || '00'x ,            00970000
        '| CHANGE' '00'x || '&1' || '00'x ||  fn  || '00'x ,            00980000
        '| CHANGE' '00'x || '&2' || '00'x ||  ft  || '00'x ,            00990000
        '| CHANGE' '00'x || '&3' || '00'x ||  fm  || '00'x ,            01000000
        '| CHANGE' '00'x || '&4' || '00'x || menu || '00'x ,            01010000
                '| VAR PIPE'                                            01020000
                                                                        01030000
        If rc = 0 Then Do                                               01040000
                                                                        01050000
            /*  if auth non-blank  */                                   01060000
            If ^gopsrvau(client,auth) Then Do                           01070000
                /*  "access restricted"  */                             01080000
                'CALLPIPE COMMAND XMITMSG 2380' ,                       01090000
                    '(CALLER GOP ERRMSG' ,                              01100000
                        '| SPEC /- / 1 1-* NEXT | *:'                   01110000
                Exit rc                                                 01120000
                End  /*  If  ..  Do  */                                 01130000
                                                                        01140000
            If pipe ^= "" Then Do                                       01150000
                menu = fn                                               01160000
                Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT MENU'     01170000
                'CALLPIPE' pipe '| *:'                                  01180000
                Exit rc                                                 01190000
                End  /*  If  ..  Do  */                                 01200000
                                                                        01210000
            End  /*  If  ..  Do  */                                     01220000
                                                                        01230000
        End  /*  If  ..  Do  */                                         01240000
                                                                        01250000
    End  /*  If  ..  Do  */                                             01260000
                                                                        01270000
If Index(fn ft, '*') = 0 Then Do                                        01280000
    Address "CMS" 'STATE' fn ft fm                                      01290000
    If rc = 0 Then Do                                                   01300000
        'CALLPIPE <' fn ft fm '| *:'                                    01310000
        Exit rc                                                         01320000
        End                                                             01330000
    Exit rc                                                             01340000
    End                                                                 01350000
                                                                        01360000
If Index(fn,'*') = 0 & ft = '*' Then Do                                 01370000
                                                                        01380000
    Address "COMMAND" 'GLOBALV SELECT GOPHERD SET MENU' fn              01390000
                                                                        01400000
    Address "CMS" 'STATE' fn 'FILELIST' fm                              01410000
    If  rc = 0  Then Do     /*  menu is a FILELIST  */                  01420000
        'CALLPIPE <' fn 'FILELIST' fm '| *:'                            01430000
        Exit rc                                                         01440000
        End  /*  If  ..  Do  */                                         01450000
                                                                        01460000
    If fm = '*' | fm = "" Then fm = 'A'                                 01470000
    'CALLPIPE COMMAND ACCESS +' || fm || '.' || fn fm                   01480000
    If rc = 0 Then Do                                                   01490000
        /*  menu is an SFS sub-directory  */                            01500000
        'CALLPIPE' arg0 '* *' fm '| *:'                                 01510000
        lrc = rc                                                        01520000
        'CALLPIPE COMMAND ACCESS -' || fm fm                            01530000
        Exit lrc                                                        01540000
        End  /*  If  ..  Do  */                                         01550000
    If rc = 28 | rc = 100 Then Exit rc                                  01560000
    End                                                                 01570000
                                                                        01580000
/*  shortcut for GOPSRVRP on LISTFILE not FILELIST  */                  01590000
'OUTPUT' " "                                                            01600000
If rc ^= 0 Then Exit rc * (rc ^= 12)                                    01610000
                                                                        01620000
/*  list all files in this directory  */                                01630000
'ADDPIPE COMMAND LISTFILE' fn ft fm '(ALLFILE ALLOC NOHEADER | *.INPUT:'01640000
If rc ^= 0 Then Do                                                      01650000
    'CALLPIPE COMMAND LISTFILE' fn ft fm '(NOHEADER | *:'               01660000
    Exit rc                                                             01670000
    End  /*  If  ..  Do  */                                             01680000
                                                                        01690000
/*  give SFS directories a filetype '*'  */                             01700000
Do Forever                                                              01710000
                                                                        01720000
    'PEEKTO RECORD'                                                     01730000
    If rc ^= 0 Then Leave                                               01740000
                                                                        01750000
    Parse Var record fn ft fm .                                         01760000
    If fm = "DIR" Then 'OUTPUT' "     " fn '*' ft                       01770000
                  Else 'OUTPUT' "     " fn ft fm                        01780000
                                                                        01790000
    'READTO'                                                            01800000
    If rc ^= 0 Then Leave                                               01810000
                                                                        01820000
    End  /*  If  ..  Do  Forever  */                                    01830000
                                                                        01840000
Exit rc * (rc ^= 12)                                                    01850000
                                                                        01860000
:READ  GOPSRVRP $REXX    A1 TMP200 01/25/93 15:24:33
/*                                                                      00010000
 *        Name: GOPSRVRP REXX                                           00020000
 *              resolve gopher paths (selector strings) recursively     00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1993-Jan-15, 19                                         00050000
 *                                                                      00060000
 *              This file is part of CMS Gopher.                        00070000
 */                                                                     00080000
                                                                        00090000
/*                                                                      00100000
 *      Copyright 1993 Richard M. Troth.   This software was developed  00110000
 *      with resources provided by Rice University and is intended      00120000
 *      to serve Rice's user community.   Rice has benefitted greatly   00130000
 *      from the free distribution of software,  therefore distribution 00140000
 *      of unmodified copies of this material is not restricted.        00150000
 *      You may change your own copy as needed.   Neither Rice          00160000
 *      University nor any of its employees or students shall be held   00170000
 *      liable for damages resulting from the use of this software.     00180000
 */                                                                     00190000
                                                                        00200000
Parse Source . . arg0 .                                                 00210000
Parse Arg nick '/' rest                                                 00220000
nick = Strip(nick)                                                      00230000
rest = Strip(rest)                                                      00240000
                                                                        00250000
Do While nick = ""      /*  deal with null parts w/o recursion  */      00260000
    If rest = "" Then Do; 'SHORT'; Exit rc; End                         00270000
    Parse Var rest nick '/' rest                                        00280000
    End  /*  Do  While  */                                              00290000
/*                                                                      00300000
If nick = "" Then Do    **  deal with null parts by recursion  **       00310000
    If rest = "" Then 'SHORT'                                           00320000
                 Else 'CALLPIPE *: |' arg0 rest '| *:'                  00330000
    Exit rc                                                             00340000
    End  **  If  ..  Do  **                                             00350000
 */                                                                     00360000
                                                                        00370000
/*  look for the shortcut on pure LISTFILE ouptut  */                   00380000
'PEEKTO RECORD'                                                         00390000
If rc ^= 0 Then Exit rc * (rc ^= 12)                                    00400000
If Strip(record) = "" Then Signal SHORTCUT                              00410000
                                                                        00420000
/*  part = nick;  Upper part  */                                        00430000
Parse Upper Var nick part                                               00440000
                                                                        00450000
Do Forever                                                              00460000
                                                                        00470000
    'READTO RECORD'                                                     00480000
    If rc ^= 0 Then Leave                                               00490000
    If Left(record,1) = '*' Then Iterate                                00500000
    If Left(record,1) ^= ' ' Then Leave         /*  short cut  */       00510000
                                                                        00520000
    Parse Upper Var record fn ft fm fp '"' . "'" . '05'x .              00530000
    If Strip(fn) = "" Then Iterate                                      00540000
                                                                        00550000
    If  fp = "" Then  Select  /*  ft  */                                00560000
        When  Index(fn,'*') > 0 Then    fp = fn || '.' || ft            00570000
        When  ft = ""   | ft = "*"  | ,                                 00580000
              ft = "FILELIST"   Then    fp = fn                         00590000
        Otherwise                       fp = fn || '.' || ft            00600000
        End  /*  Select  ft  */                                         00610000
    If Strip(fp) ^= part Then Iterate                                   00620000
                                                                        00630000
Say "GOPSRVRP: matched" fn ft fm fp                                     00640000
    /*  found it!  */                                                   00650000
    /*  Parse Arg nick '/' .  */                                        00660000
    Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT NICK'                 00670000
    If rest = "" Then 'CALLPIPE GOPSRVLS' fn ft fm '| *:'               00680000
                 Else 'CALLPIPE GOPSRVLS' fn ft fm '|' arg0 rest '| *:' 00690000
    /*  Leave  */  Exit rc                                              00700000
                                                                        00710000
    End                                                                 00720000
                                                                        00730000
FALLOUT:                                                                00740000
Say "GOPSRVRP: didn't find a match for" nick                            00750000
/*  fallout;  we didn't find a match in this menu  */                   00760000
/*  Parse Arg nick  */                                                  00770000
nick = nick || '/' || rest                                              00780000
Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT NICK'                     00790000
'CALLPIPE GOPSRVLS ? ? ? | *:'                                          00800000
                                                                        00810000
Exit rc                                                                 00820000
                                                                        00830000
SHORTCUT:                                                               00840000
Parse Var                                                               00850000
Say "GOPSRVRP: shortcut to" fn ft fm fp                                 00860000
    /*  found it!  */                                                   00870000
    /*  Parse Arg nick '/' .  */                                        00880000
    Address "COMMAND" 'GLOBALV SELECT GOPHERD PUT NICK'                 00890000
    If rest = "" Then 'CALLPIPE GOPSRVLS' fn ft fm '| *:'               00900000
                 Else 'CALLPIPE GOPSRVLS' fn ft fm '|' arg0 rest '| *:' 00910000
    /*  Leave  */  Exit rc                                              00920000
                                                                        00930000
                                                                        00940000
:READ  GOPSRVMB $REXX    A1 TMP200 01/25/93 15:24:29
/*                                                                      00010000
 *        Name: GOPSRVMB REXX                                           00020000
 *              CMS Gopher Server menu builder pipeline stage           00030000
 *              Based on the older GOPHERDM REXX stage from 2.3.        00040000
 *      Author: Rick Troth, Rice University, Information Systems        00050000
 *        Date: 1993-Jan-15                                             00060000
 */                                                                     00070000
                                                                        00080000
/*                                                                      00090000
 *      Copyright 1993 Richard M. Troth.   This software was developed  00100000
 *      with resources provided by Rice University and is intended      00110000
 *      to serve Rice's user community.   Rice has benefitted greatly   00120000
 *      from the free distribution of software,  therefore distribution 00130000
 *      of unmodified copies of this material is not restricted.        00140000
 *      You may change your own copy as needed.   Neither Rice          00150000
 *      University nor any of its employees or students shall be held   00160000
 *      liable for damages resulting from the use of this software.     00170000
 */                                                                     00180000
                                                                        00190000
uc = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"                                       00200000
lc = "abcdefghijklmnopqrstuvwxyz"                                       00210000
                                                                        00220000
/*  sync with input  */                                                 00230000
'PEEKTO'                                                                00240000
If rc ^= 0 Then Exit rc * (rc ^= 12)                                    00250000
                                                                        00260000
/*  experience shows that sometimes GLOBALV SELECT        *             00270000
 *  doesn't work unless you explicitly sync with PEEKTO   */            00280000
Address "COMMAND" 'GLOBALV SELECT GOPHERD GET HOST PORT PATH MENU'      00290000
localhost = host                                                        00300000
localport = port                                                        00310000
localpath = path                                                        00320000
Say "Global PATH =" path                                                00330000
                                                                        00340000
Do Forever                                                              00350000
                                                                        00360000
    'PEEKTO RECORD'                                                     00370000
    If rc ^= 0 Then Leave                                               00380000
                                                                        00390000
    key = Left(record,1)                                                00400000
    Select  /*  key  */                                                 00410000
        When key = "*" Then nop                                         00420000
        When Strip(record) = "" Then nop                                00430000
        When key = " " Then Call FILELIST                               00440000
        Otherwise           Call PREFAB                                 00450000
        End  /*  Select  key  */                                        00460000
    If rc ^= 0 Then Leave                                               00470000
                                                                        00480000
    'READTO'                                                            00490000
    If rc ^= 0 Then Leave                                               00500000
                                                                        00510000
    End  /*  Do  For  */                                                00520000
                                                                        00530000
Exit rc * (rc ^= 12)                                                    00540000
                                                                        00550000
                                                                        00560000
                                                                        00570000
/* ------------------------------------------------------------ FILELIST00580000
 *  We're apparently reading a plain FILELIST or LISTFILE output.       00590000
 */                                                                     00600000
FILELIST:                                                               00610000
                                                                        00620000
q1 = Index(record,"'")                                                  00630000
q2 = Index(record,'"')                                                  00640000
Select                                                                  00650000
    When  q1 = 0  & q2 = 0  Then                                        00660000
        Parse Var record fn ft fm fp '05'x name '05'x type '05'x .      00670000
    When  q1 = 0  Then                                                  00680000
        Parse Var record fn ft fm fp '"'name'"' type .                  00690000
    When  q2 = 0  Then                                                  00700000
        Parse Var record fn ft fm fp "'"name"'" type .                  00710000
    When  q1 > q2 Then                                                  00720000
        Parse Var record fn ft fm fp '"'name'"' type .                  00730000
    When  q2 > 0  Then                                                  00740000
        Parse Var record fn ft fm fp "'"name"'" type .                  00750000
    End  /*  Select  */                                                 00760000
                                                                        00770000
If ft = "" Then ft = "*"                                                00780000
If fm = "" Then fm = "*"                                                00790000
If ft = "GOPHER" | ft = "GOPLINK" Then Do                               00800000
    /*  read gopher link information  */                                00810000
    'CALLPIPE <' fn ft fm '| GOPSRVGL | *:'                             00820000
    Return                                                              00830000
    End                                                                 00840000
                                                                        00850000
/*  this is for Yossie:  hide filemode zero  */                         00860000
If Length(fm) > 1 Then If Substr(fm,2,1) = '0' Then Return              00870000
                                                                        00880000
fp = Strip(fp)                                                          00890000
If fp = "" Then Do                                                      00900000
    If  Index(fn ft, '*') > 0   | ,                                     00910000
        ft = "FILELIST"         Then fp = Translate(fn,lc,uc)           00920000
    Else  fp = Translate(fn||'.'||ft,lc,uc)                             00930000
    End  /*  If  ..  Do  */                                             00940000
                                                                        00950000
If name = "" Then name = fp     /*  default name is relative path  */   00960000
fp = Translate(fp,"%","/")        /*  no slashes in partial path!  */   00970000
If type = "" Then type = gtype(ft)                                      00980000
host = localhost                                                        00990000
port = localport                                                        01000000
path = type || localpath || '/' || fp                                   01010000
                                                                        01020000
/* read overrides from the NAMES file, if any */                        01030000
If menu ^= "" Then Call GOVER                                           01040000
                                                                        01050000
'OUTPUT' type || name || '05'x || ,                                     01060000
      /* type */ path || '05'x || ,                                     01070000
                 host || '05'x || port                                  01080000
                                                                        01090000
Return                                                                  01100000
                                                                        01110000
                                                                        01120000
                                                                        01130000
/* -------------------------------------------------------------- PREFAB01140000
 *  Preceeding stage has supplied some of the parameters.  (thank you)  01150000
 */                                                                     01160000
PREFAB:                                                                 01170000
                                                                        01180000
Parse Var record name '05'x path '05'x host '05'x port '05'x rest       01190000
Parse Var path 1 type 2 path                                            01200000
path = type || localpath || '/' || path                                 01210000
If host = "" Then host = localhost                                      01220000
If port = "" Then port = localport                                      01230000
'OUTPUT' name || '05'x || path || '05'x || ,                            01240000
         host || '05'x || port || '05'x || rest                         01250000
Return                                                                  01260000
                                                                        01270000
                                                                        01280000
                                                                        01290000
/* --------------------------------------------------------------- GOVER01300000
 *  Read the specified NAMES file for menu data overrides, if any.      01310000
 */                                                                     01320000
GOVER:                                                                  01330000
                                                                        01340000
Address "COMMAND" 'STATE' menu 'NAMES *'                                01350000
If rc ^= 0 Then Return                                                  01360000
                                                                        01370000
'CALLPIPE COMMAND NAMEFIND :NICK' fp ,                                  01380000
        ':TYPE :NAME :PATH :HOST :PORT (FILE' menu ,                    01390000
        '| VAR _TYPE | DROP | VAR _NAME | DROP | VAR _PATH | DROP' ,    01400000
        '| VAR _HOST | DROP | VAR _PORT'                                01410000
If rc ^= 0 Then                                                         01420000
'CALLPIPE COMMAND NAMEFIND :FN' fn ':FT' ft ,                           01430000
        ':TYPE :NAME :PATH :HOST :PORT (FILE' menu ,                    01440000
        '| VAR _TYPE | DROP | VAR _NAME | DROP | VAR _PATH | DROP' ,    01450000
        '| VAR _HOST | DROP | VAR _PORT'                                01460000
If rc ^= 0 Then Return                                                  01470000
                                                                        01480000
/*      defaults for  type, name, path, host, port    *                 01490000
 *      are supplied by the calling routine           */                01500000
                                                                        01510000
If _host ^= "" Then host = _host                                        01520000
If _port ^= "" Then port = _port                                        01530000
If _path ^= "" Then path = _path                                        01540000
If _name ^= "" Then name = _name                                        01550000
If _type ^= "" Then type = _type                                        01560000
                                                                        01570000
Select                                                                  01580000
    When _host ^= "" & _port = "" Then port = 70                        01590000
    When _host = "" & _port ^= "" Then host = localhost                 01600000
    Otherwise nop                                                       01610000
    End  /*  When  Select  */                                           01620000
                                                                        01630000
If _host ^= "" | _port ^= "" Then Do                                    01640000
    path = _path                                                        01650000
    type = _type                                                        01660000
    If type = "" Then type = "1"                                        01670000
    End  /*  If  ..  Do  */                                             01680000
Else If _type ^= "" & _path = "" Then                                   01690000
    path = _type || localpath || '/' || fp                              01700000
                                                                        01710000
Return                                                                  01720000
                                                                        01730000
                                                                        01740000
                                                                        01750000
/* --------------------------------------------------------------- GTYPE01760000
 * Returns the default Gopher type character for CMS filetype specified.01770000
 */                                                                     01780000
GTYPE:    Procedure                                                     01790000
Parse Arg ft                                                            01800000
Select  /*  ft  */                                                      01810000
    When ft = "*"        Then Return '1'                                01820000
    When ft = "-"        Then Return '1'                                01830000
    When ft = ""         Then Return '1'                                01840000
    When ft = "FILELIST" Then Return '1'                                01850000
    When ft = "GOPHER"   Then Return '1'                                01860000
/*  When ft = "CSO"      Then Return '2'  */                            01870000
/*  When ft = ?          Then Return '3'  */                            01880000
/*  When ft = "MAC"      Then Return '4'  */                            01890000
/*  When ft = "DOS"      Then Return '5'  */                            01900000
    When ft = "UUE"      Then Return '6'                                01910000
/*  When ft = "SEARCH"   Then Return '7'  */                            01920000
/*  When ft = "TELNET"   Then Return '8'  */                            01930000
    When ft = "TXT"      Then Return '0'    /*  plain text  */          01940000
    When ft = "TEXT"     Then Return '9'    /*  deck; not plain text  */01950000
    When ft = "TXTLIB"   Then Return '9'                                01960000
    When Left(ft,3) = "TXT" Then Return '9'                             01970000
    When ft = "CARDDUMP" Then Return '9'                                01980000
    When ft = "TAR"      Then Return '9'                                01990000
    When ft = "EXE"      Then Return '9'                                02000000
    When ft = "DVI"      Then Return '9'                                02010000
    When ft = "TFM"      Then Return '9'                                02020000
    When ft = "FMT"      Then Return '9'                                02030000
    When ft = "ADMGDF"   Then Return '9'                                02040000
    When ft = "ADMSYMBL" Then Return '9'                                02050000
    When ft = "SASUSER"  Then Return '9'                                02060000
    When ft = "SAS6USER" Then Return '9'                                02070000
    When ft = "SND"      Then Return 's'                                02080000
/*  When ft = "EPS"      Then Return 'p'  */                            02090000
/*  When ft = "PS"       Then Return 'p'  */                            02100000
    When ft = "MODULE"   Then Return 'v'                                02110000
    When ft = "LOADLIB"  Then Return 'v'                                02120000
    When ft = "XRX"      Then Return 'v'                                02130000
    When ft = "GIF"      Then Return 'I'                                02140000
    Otherwise                 Return '0'                                02150000
    End  /*  Select  ft  */                                             02160000
                                                                        02170000
:READ  GOPSRVGL $REXX    A1 TMP200 01/25/93 15:24:24
/*                                                                      00010000
 *        Name: GOPSRVGL REXX                                           00020000
 *              read and process a GOPHER (link) file for GOPHERD       00030000
 *      Author: Rick Troth, Rice University, Information Systems        00040000
 *        Date: 1993-Jan-15                                             00050000
 */                                                                     00060000
                                                                        00070000
/*                                                                      00080000
 *      Copyright 1993 Richard M. Troth.   This software was developed  00090000
 *      with resources provided by Rice University and is intended      00100000
 *      to serve Rice's user community.   Rice has benefitted greatly   00110000
 *      from the free distribution of software,  therefore distribution 00120000
 *      of unmodified copies of this material is not restricted.        00130000
 *      You may change your own copy as needed.   Neither Rice          00140000
 *      University nor any of its employees or students shall be held   00150000
 *      liable for damages resulting from the use of this software.     00160000
 */                                                                     00170000
                                                                        00180000
Address "COMMAND" 'GLOBALV SELECT GOPHERD GET HOST PORT'                00190000
localhost = host;   localport = port                                    00200000
host = "";  port = "";  path = "";  name = "";  type = ""               00210000
                                                                        00220000
Do Forever                                                              00230000
                                                                        00240000
    'PEEKTO RECORD'                                                     00250000
    If rc ^= 0 Then Leave                                               00260000
                                                                        00270000
    If Left(record,1) = '*' Then Call WRITELINK                         00280000
    If Left(record,1) = '#' Then Call WRITELINK                         00290000
    If rc ^= 0 Then Leave                                               00300000
                                                                        00310000
    Parse Var record var '=' val                                        00320000
    Upper var; var = Strip(var)                                         00330000
    Select  /*  var  */                                                 00340000
        When var = "TYPE" Then type = Strip(val)                        00350000
        When var = "NAME" Then name = val                               00360000
        When var = "PATH" Then path = val                               00370000
        When var = "HOST" Then host = Strip(val)                        00380000
        When var = "PORT" Then port = Strip(val)                        00390000
        Otherwise nop   /*  ignore invalid lines  */                    00400000
        End  /*  Select  var  */                                        00410000
                                                                        00420000
    'READTO'                                                            00430000
    If rc ^= 0 Then Leave                                               00440000
                                                                        00450000
    End  /*  Do  Forever  */                                            00460000
                                                                        00470000
If rc = 12 Then Call WRITELINK                                          00480000
                                                                        00490000
Exit rc * (rc ^= 12)                                                    00500000
                                                                        00510000
                                                                        00520000
                                                                        00530000
/* ----------------------------------------------------------- WRITELINK00540000
 *  Looks like a break.  Iff we have everthing,                         00550000
 *  then write this link and reset the variables to empty strings.      00560000
 */                                                                     00570000
WRITELINK:                                                              00580000
If  name = "" | type = "" Then  Return                                  00590000
If  host = ""   Then host = localhost                                   00600000
If  host = "+"  Then host = localhost                                   00610000
If  type = "FILE"       Then type = '0'                                 00620000
If  type = "DIRECTORY"  Then type = '1'                                 00630000
If  port = "" Then                                                      00640000
Select  /*  type  */                                                    00650000
    When  type = '2'  Then port = '105'                                 00660000
    When  type = '8'  Then port = '23'                                  00670000
    When  type = 'T'  Then port = '23'                                  00680000
    Otherwise port = '70'                                               00690000
    End  /*  Select  type  */                                           00700000
'OUTPUT' type || name || '05'x || path || '05'x ,                       00710000
              || host || '05'x || port                                  00720000
host = "";  port = "";  path = "";  name = "";  type = ""               00730000
Return                                                                  00740000
                                                                        00750000
:READ  GOPSRVAU $EXEC    A1 TMP200 01/25/93 15:24:19
/*                                                                      00010000
 *        Name: GOPSRVAU EXEC, authorization function                   00020000
 *              returns TRUE (1) if the file/menu may be retrieved      00030000
 *              returns FALSE (0) otherwise                             00040000
 *        Date: 1993-Jan-18                                             00050000
 *      Author: Rick Troth, Rice University, Information Systems        00060000
 *                                                                      00070000
 *              This file is part of CMS Gopher.                        00080000
 */                                                                     00090000
                                                                        00100000
/*                                                                      00110000
 *      Copyright 1993 Richard M. Troth.   This software was developed  00120000
 *      with resources provided by Rice University and is intended      00130000
 *      to serve Rice's user community.   Rice has benefitted greatly   00140000
 *      from the free distribution of software,  therefore distribution 00150000
 *      of unmodified copies of this material is not restricted.        00160000
 *      You may change your own copy as needed.   Neither Rice          00170000
 *      University nor any of its employees or students shall be held   00180000
 *      liable for damages resulting from the use of this software.     00190000
 */                                                                     00200000
                                                                        00210000
/* ---------------------------------------------------------- AUTHORIZED00220000
 * Verify that the client is allowed access, based on IP addr or name.  00230000
 * (we originally used an internal routine called IPA2C(),  but Arty's  00240000
 * RXSOCKET provides an Inet_addr() function,  which is now preferred)  00250000
 */                                                                     00260000
AUTHORIZED:                                                             00270000
Parse Upper Arg Client,AuthList                                         00280000
If AuthList = "" Then Return 1                                          00290000
ClientAddr = Inet_addr(Client)                                          00300000
                                                                        00310000
rc = Socket('GetHostByAddr', ClientAddr, 'ClientName')                  00320000
If rc = "-1" Then ClientName = Client                                   00330000
Say "Client looks like" ClientName Inet_ntoa(ClientAddr)                00340000
Upper ClientName                                                        00350000
                                                                        00360000
allow = 1                                                               00370000
Do While AuthList ^= ""                                                 00380000
                                                                        00390000
    Parse Var AuthList Auth AuthList                                    00400000
    If Auth = "DENY" Then Do                                            00410000
        allow = 0; Parse Var AuthList Auth AuthList                     00420000
        End  /*  If  ..  Do  */                                         00430000
    If Auth = "ALLOW" Then Do                                           00440000
        allow = 1; Parse Var AuthList Auth AuthList                     00450000
        End  /*  If  ..  Do  */                                         00460000
    Say "Auth" Auth                                                     00470000
    If Auth = '*' Then Return allow                                     00480000
                                                                        00490000
    Parse Var Auth Auth "," AuthMask "," .                              00500000
    AuthAddr = Inet_addr(Auth)                                          00510000
    If AuthAddr = "-1" Then Do              /* process as a name spec */00520000
        If Left(Auth,1) = '.' Then Do                                   00530000
            TruncName = Right(ClientName,Length(Auth))                  00540000
            Say "Truncated ClientName" TruncName                        00550000
            If TruncName = Auth Then Return allow                       00560000
            End  /*  If  ..  Do  */                                     00570000
        Else If ClientName = Auth Then Return allow                     00580000
        End  /*  If  ..  Do  */                                         00590000
                                                                        00600000
    Else Do                                 /* must be a numeric spec */00610000
        AuthMask = Inet_addr(AuthMask)                                  00620000
        If AuthMask = "-1" Then Do                                      00630000
            AuthMask = bitand(AuthAddr,'C0000000'x)                     00640000
            Select  /*  AuthMask  */                                    00650000
                When AuthMask = '00000000'x Then AuthMask = 'FF000000'x 00660000
                When AuthMask = '80000000'x Then AuthMask = 'FFFF0000'x 00670000
                When AuthMask = 'C0000000'x Then AuthMask = 'FFFFFF00'x 00680000
                End  /*  Select  AuthMask  */                           00690000
            End  /*  If  ..  Do  */                                     00700000
        Say "ADDR" c2x(AuthAddr) "MASK" c2x(AuthMask)                   00710000
        AuthAddr = bitxor(AuthAddr,ClientAddr)                          00720000
        AuthAddr = bitand(AuthAddr,AuthMask)                            00730000
        If AuthAddr = '00000000'x Then Return allow                     00740000
        End  /*  Else  Do  */                                           00750000
                                                                        00760000
    End  /*  Do  While  */                                              00770000
                                                                        00780000
Return 0                                                                00790000
                                                                        00800000
:READ  GOPSRVYS $REXX    A1 TMP200 01/22/93 15:41:34
/*
 *        Name: GOPSRVYS REXX
 *              Gopher Server Search Engine utilizing WISHLP
 *              Original by Yossie Silverman <YOSSIE@UCSFVM>
 *
 *   To create a search item do the following:
 *
 *     1) Create a standard gopher FILELIST of all files to be
 *        searched.  (Only ' fn ft fm title' will work, fm can
 *        (and should) be *
 *     2) GOPGEN INDEX menu
 *     3) Put the name and title of the searched menu
 *        in the menu you want to access it from (parent)
 *     4) Mark the searched menu as Type 7 either
 *        with a NAMES file or in the parent menu.
 */

Parse Arg search                            /* retrieve search string */

'PEEKTO'            /*  sync with input  */

Address "COMMAND" 'GLOBALV SELECT GOPHERD GET MENU FM'
'CALLPIPE COMMAND LISTFILE' menu 'GOPINDEX * (NOHEADER' ,
        '| VAR FILESPEC'
If rc ^= 0 Then Exit rc
Parse Var filespec . . fm .
Say "GOPSRVYS: MENU =" menu '-' fm
'CALLPIPE COMMAND WISHLP' menu 'GOPINDEX' fm search ,
        '| SPEC /      / 1 1-* NEXT | *:'

Exit rc

:READ  VMGOPHER CNTRL    A1 TMP200 01/22/93 11:00:56
TEXT MACS
TEXT AUXGOP24
*LCL AUXLCL